summaryrefslogtreecommitdiff
path: root/lib/dialyzer
diff options
context:
space:
mode:
authorLukas Larsson <lukas@erlang.org>2020-07-08 17:18:53 +0200
committerLukas Larsson <lukas@erlang.org>2020-09-21 16:40:30 +0200
commit5ac3338b895bc8a7c07d722b637e6b5bab830172 (patch)
tree3187242eee32dab893f22fa2e6f3ebb165b9ce45 /lib/dialyzer
parent2340ac403aba8942334c9fcbefe7aa5bf58f2363 (diff)
downloaderlang-5ac3338b895bc8a7c07d722b637e6b5bab830172.tar.gz
dialyzer: Move code in hipe that is used by dialyzer to dialyzer
HiPE may no longer always be compiled when dialyzer is needed so we move the files in hipe to dialyzer. Co-authored-by: John Högberg <john@erlang.org>
Diffstat (limited to 'lib/dialyzer')
-rw-r--r--lib/dialyzer/src/Makefile12
-rw-r--r--lib/dialyzer/src/cerl_closurean.erl856
-rw-r--r--lib/dialyzer/src/cerl_lib.erl457
-rw-r--r--lib/dialyzer/src/cerl_pmatch.erl620
-rw-r--r--lib/dialyzer/src/cerl_prettypr.erl910
-rw-r--r--lib/dialyzer/src/cerl_typean.erl994
-rw-r--r--lib/dialyzer/src/dialyzer.app.src12
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl15
-rw-r--r--lib/dialyzer/src/dialyzer_dep.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_dot.erl212
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl4
-rw-r--r--lib/dialyzer/src/erl_bif_types.erl2896
-rw-r--r--lib/dialyzer/src/erl_types.erl5731
-rw-r--r--lib/dialyzer/test/Makefile3
-rw-r--r--lib/dialyzer/test/erl_types_SUITE.erl197
17 files changed, 12912 insertions, 13 deletions
diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile
index 1f5b308c7d..4c1ce14dd9 100644
--- a/lib/dialyzer/src/Makefile
+++ b/lib/dialyzer/src/Makefile
@@ -46,7 +46,12 @@ DIALYZER_DIR = $(ERL_TOP)/lib/dialyzer
# ----------------------------------------------------
# Target Specs
# ----------------------------------------------------
-MODULES = \
+MODULES = \
+ cerl_closurean \
+ cerl_lib \
+ cerl_pmatch \
+ cerl_prettypr \
+ cerl_typean \
dialyzer \
dialyzer_analysis_callgraph \
dialyzer_behaviours \
@@ -58,6 +63,7 @@ MODULES = \
dialyzer_contracts \
dialyzer_dataflow \
dialyzer_dep \
+ dialyzer_dot \
dialyzer_explanation \
dialyzer_gui_wx \
dialyzer_options \
@@ -70,6 +76,8 @@ MODULES = \
dialyzer_coordinator \
dialyzer_worker \
dialyzer_utils \
+ erl_bif_types \
+ erl_types \
typer
HRL_FILES= dialyzer.hrl dialyzer_gui_wx.hrl
@@ -94,7 +102,7 @@ ERL_COMPILE_FLAGS += +native
else
ERL_COMPILE_FLAGS += -Werror
endif
-ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_untyped_record +warn_missing_spec
+ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_missing_spec
# ----------------------------------------------------
# Targets
diff --git a/lib/dialyzer/src/cerl_closurean.erl b/lib/dialyzer/src/cerl_closurean.erl
new file mode 100644
index 0000000000..55dcfeed1d
--- /dev/null
+++ b/lib/dialyzer/src/cerl_closurean.erl
@@ -0,0 +1,856 @@
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 2001-2002 Richard Carlsson
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @doc Closure analysis of Core Erlang programs.
+
+%% TODO: might need a "top" (`any') element for any-length value lists.
+
+-module(cerl_closurean).
+
+-export([analyze/1, annotate/1]).
+%% The following functions are exported from this module since they
+%% are also used by Dialyzer (file dialyzer/src/dialyzer_dep.erl)
+-export([is_escape_op/2, is_escape_op/3, is_literal_op/2, is_literal_op/3]).
+
+-import(cerl, [ann_c_apply/3, ann_c_fun/3, ann_c_var/2, apply_args/1,
+ apply_op/1, atom_val/1, bitstr_size/1, bitstr_val/1,
+ binary_segments/1, c_letrec/2, c_seq/2, c_tuple/1,
+ c_nil/0, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, clause_body/1,
+ clause_guard/1, clause_pats/1, cons_hd/1, cons_tl/1,
+ fun_body/1, fun_vars/1, get_ann/1, is_c_atom/1,
+ let_arg/1, let_body/1, let_vars/1, letrec_body/1,
+ letrec_defs/1, module_defs/1, module_defs/1,
+ module_exports/1, pat_vars/1, primop_args/1,
+ primop_name/1, receive_action/1, receive_clauses/1,
+ receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2,
+ try_arg/1, try_body/1, try_vars/1, try_evars/1,
+ try_handler/1, tuple_es/1, type/1, values_es/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+%% ===========================================================================
+
+-type label() :: integer() | 'top' | 'external' | 'external_call'.
+-type ordset(X) :: [X]. % XXX: TAKE ME OUT
+-type labelset() :: ordset(label()).
+-type outlist() :: [labelset()] | 'none'.
+-type escapes() :: labelset().
+
+%% ===========================================================================
+%% annotate(Tree) -> {Tree1, OutList, Outputs, Escapes, Dependencies, Parents}
+%%
+%% Tree = cerl:cerl()
+%%
+%% Analyzes `Tree' (see `analyze') and appends terms `{callers,
+%% Labels}' and `{calls, Labels}' to the annotation list of each
+%% fun-expression node and apply-expression node of `Tree',
+%% respectively, where `Labels' is an ordered-set list of labels of
+%% fun-expressions in `Tree', possibly also containing the atom
+%% `external', corresponding to the dependency information derived
+%% by the analysis. Any previous such annotations are removed from
+%% `Tree'. `Tree1' is the modified tree; for details on `OutList',
+%% `Outputs' , `Dependencies', `Escapes' and `Parents', see
+%% `analyze'.
+%%
+%% Note: `Tree' must be annotated with labels in order to use this
+%% function; see `analyze' for details.
+
+-spec annotate(cerl:cerl()) ->
+ {cerl:cerl(), outlist(), dict:dict(),
+ escapes(), dict:dict(), dict:dict()}.
+
+annotate(Tree) ->
+ {Xs, Out, Esc, Deps, Par} = analyze(Tree),
+ F = fun (T) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ X = case dict:find(L, Deps) of
+ {ok, X1} -> X1;
+ error -> set__new()
+ end,
+ set_ann(T, append_ann(callers,
+ set__to_list(X),
+ get_ann(T)));
+ apply ->
+ L = get_label(T),
+ X = case dict:find(L, Deps) of
+ {ok, X1} -> X1;
+ error -> set__new()
+ end,
+ set_ann(T, append_ann(calls,
+ set__to_list(X),
+ get_ann(T)));
+ _ ->
+%%% set_ann(T, []) % debug
+ T
+ end
+ end,
+ {cerl_trees:map(F, Tree), Xs, Out, Esc, Deps, Par}.
+
+append_ann(Tag, Val, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ append_ann(Tag, Val, Xs);
+ true ->
+ [X | append_ann(Tag, Val, Xs)]
+ end;
+append_ann(Tag, Val, []) ->
+ [{Tag, Val}].
+
+%% =====================================================================
+%% analyze(Tree) -> {OutList, Outputs, Escapes, Dependencies, Parents}
+%%
+%% Tree = cerl()
+%% OutList = [LabelSet] | none
+%% Outputs = dict(Label, OutList)
+%% Escapes = LabelSet
+%% Dependencies = dict(Label, LabelSet)
+%% LabelSet = ordset(Label)
+%% Label = integer() | top | external | external_call
+%% Parents = dict(Label, Label)
+%%
+%% Analyzes a module or an expression represented by `Tree'.
+%%
+%% The returned `OutList' is a list of sets of labels of
+%% fun-expressions which correspond to the possible closures in the
+%% value list produced by `Tree' (viewed as an expression; the
+%% "value" of a module contains its exported functions). The atom
+%% `none' denotes missing or conflicting information.
+%%
+%% The atom `external' in any label set denotes any possible
+%% function outside `Tree', including those in `Escapes'. The atom
+%% `top' denotes the top-level expression `Tree'.
+%%
+%% `Outputs' is a mapping from the labels of fun-expressions in
+%% `Tree' to corresponding lists of sets of labels of
+%% fun-expressions (or the atom `none'), representing the possible
+%% closures in the value lists returned by the respective
+%% functions.
+%%
+%% `Dependencies' is a similar mapping from the labels of
+%% fun-expressions and apply-expressions in `Tree' to sets of
+%% labels of corresponding fun-expressions which may contain call
+%% sites of the functions or be called from the call sites,
+%% respectively. Any such label not defined in `Dependencies'
+%% represents an unreachable function or a dead or faulty
+%% application.
+%%
+%% `Escapes' is the set of labels of fun-expressions in `Tree' such
+%% that corresponding closures may be accessed from outside `Tree'.
+%%
+%% `Parents' is a mapping from labels of fun-expressions in `Tree'
+%% to the corresponding label of the nearest containing
+%% fun-expression or top-level expression. This can be used to
+%% extend the dependency graph, for certain analyses.
+%%
+%% Note: `Tree' must be annotated with labels (as done by the
+%% function `cerl_trees:label/1') in order to use this function.
+%% The label annotation `{label, L}' (where L should be an integer)
+%% must be the first element of the annotation list of each node in
+%% the tree. Instances of variables bound in `Tree' which denote
+%% the same variable must have the same label; apart from this,
+%% labels should be unique. Constant literals do not need to be
+%% labeled.
+
+-record(state, {vars, out, dep, work, funs, par}).
+
+%% Note: In order to keep our domain simple, we assume that all remote
+%% calls and primops return a single value, if any.
+
+%% We use the terms `closure', `label', `lambda' and `fun-expression'
+%% interchangeably. The exact meaning in each case can be grasped from
+%% the context.
+%%
+%% Rules:
+%% 1) The implicit top level lambda escapes.
+%% 2) A lambda returned by an escaped lambda also escapes.
+%% 3) An escaped lambda can be passed an external lambda as argument.
+%% 4) A lambda passed as argument to an external lambda also escapes.
+%% 5) An argument passed to an unknown operation escapes.
+%% 6) A call to an unknown operation can return an external lambda.
+%%
+%% Escaped lambdas become part of the set of external lambdas, but this
+%% does not need to be represented explicitly.
+
+%% We wrap the given syntax tree T in a fun-expression labeled `top',
+%% which is initially in the set of escaped labels. `top' will be
+%% visited at least once.
+%%
+%% We create a separate function labeled `external', defined as:
+%% "'external'/1 = fun (Escape) -> do apply 'external'/1(apply Escape())
+%% 'external'/1", which will represent any and all functions outside T,
+%% and which returns itself, and contains a recursive call; this models
+%% rules 2 and 4 above. It will be revisited if the set of escaped
+%% labels changes, or at least once. Its parameter `Escape' is a
+%% variable labeled `escape', which will hold the set of escaped labels.
+%% initially it contains `top' and `external'.
+
+-spec analyze(cerl:cerl()) ->
+ {outlist(), dict:dict(), escapes(), dict:dict(), dict:dict()}.
+
+analyze(Tree) ->
+ %% Note that we use different name spaces for variable labels and
+ %% function/call site labels, so we can reuse some names here. We
+ %% assume that the labeling of Tree only uses integers, not atoms.
+ External = ann_c_var([{label, external}], {external, 1}),
+ Escape = ann_c_var([{label, escape}], 'Escape'),
+ ExtBody = c_seq(ann_c_apply([{label, loop}], External,
+ [ann_c_apply([{label, external_call}],
+ Escape, [])]),
+ External),
+ ExtFun = ann_c_fun([{label, external}], [Escape], ExtBody),
+%%% io:fwrite("external fun:\n~s.\n",
+%%% [cerl_prettypr:format(ExtFun, [noann])]),
+ Top = ann_c_var([{label, top}], {top, 0}),
+ TopFun = ann_c_fun([{label, top}], [], Tree),
+
+ %% The "start fun" just makes the initialisation easier. It will not
+ %% be marked as escaped, and thus cannot be called.
+ StartFun = ann_c_fun([{label, start}], [],
+ c_letrec([{External, ExtFun}, {Top, TopFun}],
+ c_nil())),
+%%% io:fwrite("start fun:\n~s.\n",
+%%% [cerl_prettypr:format(StartFun, [noann])]),
+
+ %% Gather a database of all fun-expressions in Tree and initialise
+ %% all their outputs and parameter variables. Bind all module- and
+ %% letrec-defined variables to their corresponding labels.
+ Funs0 = dict:new(),
+ Vars0 = dict:new(),
+ Out0 = dict:new(),
+ Empty = empty(),
+ F = fun (T, S = {Fs, Vs, Os}) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ As = fun_vars(T),
+ {dict:store(L, T, Fs),
+ bind_vars_single(As, Empty, Vs),
+ dict:store(L, none, Os)};
+ letrec ->
+ {Fs, bind_defs(letrec_defs(T), Vs), Os};
+ module ->
+ {Fs, bind_defs(module_defs(T), Vs), Os};
+ _ ->
+ S
+ end
+ end,
+ {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0},
+ StartFun),
+
+ %% Initialise Escape to the minimal set of escaped labels.
+ Vars1 = dict:store(escape, from_label_list([top, external]), Vars),
+
+ %% Enter the fixpoint iteration at the StartFun.
+ St = loop(StartFun, start, #state{vars = Vars1,
+ out = Out,
+ dep = dict:new(),
+ work = init_work(),
+ funs = Funs,
+ par = dict:new()}),
+%%% io:fwrite("dependencies: ~p.\n",
+%%% [[{X, set__to_list(Y)}
+%%% || {X, Y} <- dict:to_list(St#state.dep)]]),
+ {dict:fetch(top, St#state.out),
+ tidy_dict([start, top, external], St#state.out),
+ dict:fetch(escape, St#state.vars),
+ tidy_dict([loop], St#state.dep),
+ St#state.par}.
+
+tidy_dict([X | Xs], D) ->
+ tidy_dict(Xs, dict:erase(X, D));
+tidy_dict([], D) ->
+ D.
+
+loop(T, L, St0) ->
+%%% io:fwrite("analyzing: ~w.\n", [L]),
+%%% io:fwrite("work: ~w.\n", [St0#state.work]),
+ Xs0 = dict:fetch(L, St0#state.out),
+ {Xs, St1} = visit(fun_body(T), L, St0),
+ {W, M} = case equal(Xs0, Xs) of
+ true ->
+ {St1#state.work, St1#state.out};
+ false ->
+%%% io:fwrite("out (~w) changed: ~w <- ~w.\n",
+%%% [L, Xs, Xs0]),
+ M1 = dict:store(L, Xs, St1#state.out),
+ case dict:find(L, St1#state.dep) of
+ {ok, S} ->
+ {add_work(set__to_list(S), St1#state.work),
+ M1};
+ error ->
+ {St1#state.work, M1}
+ end
+ end,
+ St2 = St1#state{out = M},
+ case take_work(W) of
+ {ok, L1, W1} ->
+ T1 = dict:fetch(L1, St2#state.funs),
+ loop(T1, L1, St2#state{work = W1});
+ none ->
+ St2
+ end.
+
+visit(T, L, St) ->
+ case type(T) of
+ literal ->
+ {[empty()], St};
+ var ->
+ %% If a variable is not already in the store here, we
+ %% initialize it to empty().
+ L1 = get_label(T),
+ Vars = St#state.vars,
+ case dict:find(L1, Vars) of
+ {ok, X} ->
+ {[X], St};
+ error ->
+ X = empty(),
+ St1 = St#state{vars = dict:store(L1, X, Vars)},
+ {[X], St1}
+ end;
+ 'fun' ->
+ %% Must revisit the fun also, because its environment might
+ %% have changed. (We don't keep track of such dependencies.)
+ L1 = get_label(T),
+ St1 = St#state{work = add_work([L1], St#state.work),
+ par = set_parent([L1], L, St#state.par)},
+ {[singleton(L1)], St1};
+ values ->
+ visit_list(values_es(T), L, St);
+ cons ->
+ {Xs, St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
+ {[join_single_list(Xs)], St1};
+ tuple ->
+ {Xs, St1} = visit_list(tuple_es(T), L, St),
+ {[join_single_list(Xs)], St1};
+ 'let' ->
+ {Xs, St1} = visit(let_arg(T), L, St),
+ Vars = bind_vars(let_vars(T), Xs, St1#state.vars),
+ visit(let_body(T), L, St1#state{vars = Vars});
+ seq ->
+ {_, St1} = visit(seq_arg(T), L, St),
+ visit(seq_body(T), L, St1);
+ apply ->
+ {Xs, St1} = visit(apply_op(T), L, St),
+ {As, St2} = visit_list(apply_args(T), L, St1),
+ case Xs of
+ [X] ->
+ %% We store the dependency from the call site to the
+ %% called functions
+ Ls = set__to_list(X),
+ Out = St2#state.out,
+ Xs1 = join_list([dict:fetch(Lx, Out) || Lx <- Ls]),
+ St3 = call_site(Ls, L, As, St2),
+ L1 = get_label(T),
+ D = dict:store(L1, X, St3#state.dep),
+ {Xs1, St3#state{dep = D}};
+ none ->
+ {none, St2}
+ end;
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ {_, St1} = visit(M, L, St),
+ {_, St2} = visit(F, L, St1),
+ {Xs, St3} = visit_list(call_args(T), L, St2),
+ remote_call(M, F, Xs, St3);
+ primop ->
+ As = primop_args(T),
+ {Xs, St1} = visit_list(As, L, St),
+ primop_call(atom_val(primop_name(T)), length(Xs), Xs, St1);
+ 'case' ->
+ {Xs, St1} = visit(case_arg(T), L, St),
+ visit_clauses(Xs, case_clauses(T), L, St1);
+ 'receive' ->
+ X = singleton(external),
+ {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St),
+ {_, St2} = visit(receive_timeout(T), L, St1),
+ {Xs2, St3} = visit(receive_action(T), L, St2),
+ {join(Xs1, Xs2), St3};
+ 'try' ->
+ {Xs1, St1} = visit(try_arg(T), L, St),
+ X = singleton(external),
+ Vars = bind_vars(try_vars(T), [X], St1#state.vars),
+ {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}),
+ Evars = bind_vars(try_evars(T), [X, X, X], St2#state.vars),
+ {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = Evars}),
+ {join(join(Xs1, Xs2), Xs3), St3};
+ 'catch' ->
+ {_, St1} = visit(catch_body(T), L, St),
+ {[singleton(external)], St1};
+ binary ->
+ {_, St1} = visit_list(binary_segments(T), L, St),
+ {[empty()], St1};
+ bitstr ->
+ %% The other fields are constant literals.
+ {_, St1} = visit(bitstr_val(T), L, St),
+ {_, St2} = visit(bitstr_size(T), L, St1),
+ {none, St2};
+ letrec ->
+ %% All the bound funs should be revisited, because the
+ %% environment might have changed.
+ Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
+ St1 = St#state{work = add_work(Ls, St#state.work),
+ par = set_parent(Ls, L, St#state.par)},
+ visit(letrec_body(T), L, St1);
+ module ->
+ %% All the exported functions escape, and can thus be passed
+ %% any external closures as arguments. We regard a module as
+ %% a tuple of function variables in the body of a `letrec'.
+ visit(c_letrec(module_defs(T), c_tuple(module_exports(T))),
+ L, St)
+ end.
+
+visit_clause(T, Xs, L, St) ->
+ Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
+ {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}),
+ visit(clause_body(T), L, St1).
+
+%% We assume correct value-list typing.
+
+visit_list([T | Ts], L, St) ->
+ {Xs, St1} = visit(T, L, St),
+ {Xs1, St2} = visit_list(Ts, L, St1),
+ X = case Xs of
+ [X1] -> X1;
+ none -> none
+ end,
+ {[X | Xs1], St2};
+visit_list([], _L, St) ->
+ {[], St}.
+
+visit_clauses(Xs, [T | Ts], L, St) ->
+ {Xs1, St1} = visit_clause(T, Xs, L, St),
+ {Xs2, St2} = visit_clauses(Xs, Ts, L, St1),
+ {join(Xs1, Xs2), St2};
+visit_clauses(_, [], _L, St) ->
+ {none, St}.
+
+bind_defs([{V, F} | Ds], Vars) ->
+ bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)),
+ Vars));
+bind_defs([], Vars) ->
+ Vars.
+
+bind_pats(Ps, none, Vars) ->
+ bind_pats_single(Ps, empty(), Vars);
+bind_pats(Ps, Xs, Vars) ->
+ if length(Xs) =:= length(Ps) ->
+ bind_pats_list(Ps, Xs, Vars);
+ true ->
+ bind_pats_single(Ps, empty(), Vars)
+ end.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+ bind_pats_list(Ps, Xs, bind_vars_single(pat_vars(P), X, Vars));
+bind_pats_list([], [], Vars) ->
+ Vars.
+
+bind_pats_single([P | Ps], X, Vars) ->
+ bind_pats_single(Ps, X, bind_vars_single(pat_vars(P), X, Vars));
+bind_pats_single([], _X, Vars) ->
+ Vars.
+
+bind_vars(Vs, none, Vars) ->
+ bind_vars_single(Vs, empty(), Vars);
+bind_vars(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_vars_list(Vs, Xs, Vars);
+ true ->
+ bind_vars_single(Vs, empty(), Vars)
+ end.
+
+bind_vars_list([V | Vs], [X | Xs], Vars) ->
+ bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
+bind_vars_list([], [], Vars) ->
+ Vars.
+
+bind_vars_single([V | Vs], X, Vars) ->
+ bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
+bind_vars_single([], _X, Vars) ->
+ Vars.
+
+%% This handles a call site - adding dependencies and updating parameter
+%% variables with respect to the actual parameters. The 'external'
+%% function is handled specially, since it can get an arbitrary number
+%% of arguments, which must be unified into a single argument.
+
+call_site(Ls, L, Xs, St) ->
+%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]),
+ {D, W, V} = call_site(Ls, L, Xs, St#state.dep, St#state.work,
+ St#state.vars, St#state.funs),
+ St#state{dep = D, work = W, vars = V}.
+
+call_site([external | Ls], T, Xs, D, W, V, Fs) ->
+ D1 = add_dep(external, T, D),
+ X = join_single_list(Xs),
+ case bind_arg(escape, X, V) of
+ {V1, true} ->
+%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n",
+%%% [dict:fetch(escape, V1), dict:fetch(escape, V),
+%%% X]),
+ {W1, V2} = update_esc(set__to_list(X), W, V1, Fs),
+ call_site(Ls, T, Xs, D1, add_work([external], W1), V2, Fs);
+ {V1, false} ->
+ call_site(Ls, T, Xs, D1, W, V1, Fs)
+ end;
+call_site([L | Ls], T, Xs, D, W, V, Fs) ->
+ D1 = add_dep(L, T, D),
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args(Vs, Xs, V) of
+ {V1, true} ->
+ call_site(Ls, T, Xs, D1, add_work([L], W), V1, Fs);
+ {V1, false} ->
+ call_site(Ls, T, Xs, D1, W, V1, Fs)
+ end;
+call_site([], _, _, D, W, V, _) ->
+ {D, W, V}.
+
+%% Note that `visit' makes sure all lambdas are visited at least once.
+%% For every called function, we add a dependency from the *called*
+%% function to the function containing the call site.
+
+add_dep(Source, Target, Deps) ->
+ case dict:find(Source, Deps) of
+ {ok, X} ->
+ case set__is_member(Target, X) of
+ true ->
+ Deps;
+ false ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__add(Target, X), Deps)
+ end;
+ error ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__singleton(Target), Deps)
+ end.
+
+%% If the arity does not match the call, nothing is done here.
+
+bind_args(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_args(Vs, Xs, Vars, false);
+ true ->
+ {Vars, false}
+ end.
+
+bind_args([V | Vs], [X | Xs], Vars, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Ch),
+ bind_args(Vs, Xs, Vars1, Ch1);
+bind_args([], [], Vars, Ch) ->
+ {Vars, Ch}.
+
+bind_args_single(Vs, X, Vars) ->
+ bind_args_single(Vs, X, Vars, false).
+
+bind_args_single([V | Vs], X, Vars, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Ch),
+ bind_args_single(Vs, X, Vars1, Ch1);
+bind_args_single([], _, Vars, Ch) ->
+ {Vars, Ch}.
+
+bind_arg(L, X, Vars) ->
+ bind_arg(L, X, Vars, false).
+
+bind_arg(L, X, Vars, Ch) ->
+ X0 = dict:fetch(L, Vars),
+ X1 = join_single(X, X0),
+ case equal_single(X0, X1) of
+ true ->
+ {Vars, Ch};
+ false ->
+%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n",
+%%% [L, X1, X0, X]),
+ {dict:store(L, X1, Vars), true}
+ end.
+
+%% This handles escapes from things like primops and remote calls.
+
+%% escape(none, St) ->
+%% St;
+escape([X], St) ->
+ Vars = St#state.vars,
+ X0 = dict:fetch(escape, Vars),
+ X1 = join_single(X, X0),
+ case equal_single(X0, X1) of
+ true ->
+ St;
+ false ->
+%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
+%%% io:fwrite("updating escaping funs: ~w.\n", [set__to_list(X)]),
+ Vars1 = dict:store(escape, X1, Vars),
+ {W, Vars2} = update_esc(set__to_list(set__subtract(X, X0)),
+ St#state.work, Vars1,
+ St#state.funs),
+ St#state{work = add_work([external], W), vars = Vars2}
+ end.
+
+%% For all escaping lambdas, since they might be called from outside the
+%% program, all their arguments may be an external lambda. (Note that we
+%% only have to include the `external' label once per escaping lambda.)
+%% If the escape set has changed, we need to revisit the `external' fun.
+
+update_esc(Ls, W, V, Fs) ->
+ update_esc(Ls, singleton(external), W, V, Fs).
+
+%% The external lambda is skipped here - the Escape variable is known to
+%% contain `external' from the start.
+
+update_esc([external | Ls], X, W, V, Fs) ->
+ update_esc(Ls, X, W, V, Fs);
+update_esc([L | Ls], X, W, V, Fs) ->
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args_single(Vs, X, V) of
+ {V1, true} ->
+ update_esc(Ls, X, add_work([L], W), V1, Fs);
+ {V1, false} ->
+ update_esc(Ls, X, W, V1, Fs)
+ end;
+update_esc([], _, W, V, _) ->
+ {W, V}.
+
+set_parent([L | Ls], L1, D) ->
+ set_parent(Ls, L1, dict:store(L, L1, D));
+set_parent([], _L1, D) ->
+ D.
+
+%% Handle primop calls: (At present, we assume that all unknown primops
+%% yield exactly one value. This might have to be changed.)
+
+primop_call(F, A, Xs, St0) ->
+ case is_pure_op(F, A) of
+ %% XXX: this case is currently not possible -- commented out.
+ %% true ->
+ %% case is_literal_op(F, A) of
+ %% true -> {[empty()], St0};
+ %% false -> {[join_single_list(Xs)], St0}
+ %% end;
+ false ->
+ St1 = case is_escape_op(F, A) of
+ true -> escape([join_single_list(Xs)], St0);
+ false -> St0
+ end,
+ case is_literal_op(F, A) of
+ true -> {none, St1};
+ false -> {[singleton(external)], St1}
+ end
+ end.
+
+%% Handle remote-calls: (At present, we assume that all unknown calls
+%% yield exactly one value. This might have to be changed.)
+
+remote_call(M, F, Xs, St) ->
+ case is_c_atom(M) andalso is_c_atom(F) of
+ true ->
+ remote_call_1(atom_val(M), atom_val(F), length(Xs), Xs, St);
+ false ->
+ %% Unknown function
+ {[singleton(external)], escape([join_single_list(Xs)], St)}
+ end.
+
+remote_call_1(M, F, A, Xs, St0) ->
+ case is_pure_op(M, F, A) of
+ true ->
+ case is_literal_op(M, F, A) of
+ true -> {[empty()], St0};
+ false -> {[join_single_list(Xs)], St0}
+ end;
+ false ->
+ St1 = case is_escape_op(M, F, A) of
+ true -> escape([join_single_list(Xs)], St0);
+ false -> St0
+ end,
+ case is_literal_op(M, F, A) of
+ true -> {[empty()], St1};
+ false -> {[singleton(external)], St1}
+ end
+ end.
+
+%% Domain: none | [Vs], where Vs = set(integer()).
+
+join(none, Xs2) -> Xs2;
+join(Xs1, none) -> Xs1;
+join(Xs1, Xs2) ->
+ if length(Xs1) =:= length(Xs2) ->
+ join_1(Xs1, Xs2);
+ true ->
+ none
+ end.
+
+join_1([X1 | Xs1], [X2 | Xs2]) ->
+ [join_single(X1, X2) | join_1(Xs1, Xs2)];
+join_1([], []) ->
+ [].
+
+empty() -> set__new().
+
+singleton(X) -> set__singleton(X).
+
+from_label_list(X) -> set__from_list(X).
+
+join_single(none, Y) -> Y;
+join_single(X, none) -> X;
+join_single(X, Y) -> set__union(X, Y).
+
+join_list([Xs | Xss]) ->
+ join(Xs, join_list(Xss));
+join_list([]) ->
+ none.
+
+join_single_list([X | Xs]) ->
+ join_single(X, join_single_list(Xs));
+join_single_list([]) ->
+ empty().
+
+equal(none, none) -> true;
+equal(none, _) -> false;
+equal(_, none) -> false;
+equal(X1, X2) -> equal_1(X1, X2).
+
+equal_1([X1 | Xs1], [X2 | Xs2]) ->
+ equal_single(X1, X2) andalso equal_1(Xs1, Xs2);
+equal_1([], []) -> true;
+equal_1(_, _) -> false.
+
+equal_single(X, Y) -> set__equal(X, Y).
+
+%% Set abstraction for label sets in the domain.
+
+set__new() -> [].
+
+set__singleton(X) -> [X].
+
+set__to_list(S) -> S.
+
+set__from_list(S) -> ordsets:from_list(S).
+
+set__union(X, Y) -> ordsets:union(X, Y).
+
+set__add(X, S) -> ordsets:add_element(X, S).
+
+set__is_member(X, S) -> ordsets:is_element(X, S).
+
+set__subtract(X, Y) -> ordsets:subtract(X, Y).
+
+set__equal(X, Y) -> X =:= Y.
+
+%% A simple but efficient functional queue.
+
+queue__new() -> {[], []}.
+
+queue__put(X, {In, Out}) -> {[X | In], Out}.
+
+queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
+queue__get({[], _}) -> empty;
+queue__get({In, _}) ->
+ [X | In1] = lists:reverse(In),
+ {ok, X, {[], In1}}.
+
+%% The work list - a queue without repeated elements.
+
+init_work() ->
+ {queue__new(), sets:new()}.
+
+add_work(Ls, {Q, Set}) ->
+ add_work(Ls, Q, Set).
+
+%% Note that the elements are enqueued in order.
+
+add_work([L | Ls], Q, Set) ->
+ case sets:is_element(L, Set) of
+ true ->
+ add_work(Ls, Q, Set);
+ false ->
+ add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
+ end;
+add_work([], Q, Set) ->
+ {Q, Set}.
+
+take_work({Queue0, Set0}) ->
+ case queue__get(Queue0) of
+ {ok, L, Queue1} ->
+ Set1 = sets:del_element(L, Set0),
+ {ok, L, {Queue1, Set1}};
+ empty ->
+ none
+ end.
+
+%% Escape operators may let their arguments escape. Unless we know
+%% otherwise, and the function is not pure, we assume this is the case.
+%% Error-raising functions (fault/match_fail) are not considered as
+%% escapes (but throw/exit are). Zero-argument functions need not be
+%% listed.
+
+-spec is_escape_op(atom(), arity()) -> boolean().
+
+is_escape_op(match_fail, 1) -> false;
+is_escape_op(recv_wait_timeout, 1) -> false;
+is_escape_op(F, A) when is_atom(F), is_integer(A) -> true.
+
+-spec is_escape_op(atom(), atom(), arity()) -> boolean().
+
+is_escape_op(erlang, error, 1) -> false;
+is_escape_op(erlang, error, 2) -> false;
+is_escape_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> true.
+
+%% "Literal" operators will never return functional values even when
+%% found in their arguments. Unless we know otherwise, we assume this is
+%% not the case. (More functions can be added to this list, if needed
+%% for better precision. Note that the result of `term_to_binary' still
+%% contains an encoding of the closure.)
+
+-spec is_literal_op(atom(), arity()) -> boolean().
+
+is_literal_op(recv_wait_timeout, 1) -> true;
+is_literal_op(match_fail, 1) -> true;
+is_literal_op(F, A) when is_atom(F), is_integer(A) -> false.
+
+-spec is_literal_op(atom(), atom(), arity()) -> boolean().
+
+is_literal_op(erlang, '+', 2) -> true;
+is_literal_op(erlang, '-', 2) -> true;
+is_literal_op(erlang, '*', 2) -> true;
+is_literal_op(erlang, '/', 2) -> true;
+is_literal_op(erlang, '=:=', 2) -> true;
+is_literal_op(erlang, '==', 2) -> true;
+is_literal_op(erlang, '=/=', 2) -> true;
+is_literal_op(erlang, '/=', 2) -> true;
+is_literal_op(erlang, '<', 2) -> true;
+is_literal_op(erlang, '=<', 2) -> true;
+is_literal_op(erlang, '>', 2) -> true;
+is_literal_op(erlang, '>=', 2) -> true;
+is_literal_op(erlang, 'and', 2) -> true;
+is_literal_op(erlang, 'or', 2) -> true;
+is_literal_op(erlang, 'not', 1) -> true;
+is_literal_op(erlang, length, 1) -> true;
+is_literal_op(erlang, size, 1) -> true;
+is_literal_op(erlang, fun_info, 1) -> true;
+is_literal_op(erlang, fun_info, 2) -> true;
+is_literal_op(erlang, fun_to_list, 1) -> true;
+is_literal_op(erlang, throw, 1) -> true;
+is_literal_op(erlang, exit, 1) -> true;
+is_literal_op(erlang, error, 1) -> true;
+is_literal_op(erlang, error, 2) -> true;
+is_literal_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> false.
+
+%% Pure functions neither affect the state, nor depend on it.
+
+is_pure_op(F, A) when is_atom(F), is_integer(A) -> false.
+
+is_pure_op(M, F, A) -> erl_bifs:is_pure(M, F, A).
+
+%% =====================================================================
diff --git a/lib/dialyzer/src/cerl_lib.erl b/lib/dialyzer/src/cerl_lib.erl
new file mode 100644
index 0000000000..3a6fb1cf51
--- /dev/null
+++ b/lib/dialyzer/src/cerl_lib.erl
@@ -0,0 +1,457 @@
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @doc Utility functions for Core Erlang abstract syntax trees.
+%%
+%% <p>Syntax trees are defined in the module <a
+%% href=""><code>cerl</code></a>.</p>
+%%
+%% @type cerl() = cerl:cerl()
+
+-module(cerl_lib).
+
+-define(NO_UNUSED, true).
+
+-export([is_safe_expr/2, reduce_expr/1, is_simple_clause/1,
+ is_bool_switch/1, bool_switch_cases/1]).
+-ifndef(NO_UNUSED).
+-export([is_safe_expr/1, is_pure_expr/1, is_pure_expr/2,
+ make_bool_switch/3]).
+-endif.
+
+
+%% Test if a clause has a single pattern and an always-true guard.
+
+-spec is_simple_clause(cerl:c_clause()) -> boolean().
+
+is_simple_clause(C) ->
+ case cerl:clause_pats(C) of
+ [_P] ->
+ G = cerl:clause_guard(C),
+ case cerl_clauses:eval_guard(G) of
+ {value, true} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% Creating an if-then-else construct that can be recognized as such.
+%% `Test' *must* be guaranteed to return a boolean.
+
+-ifndef(NO_UNUSED).
+make_bool_switch(Test, True, False) ->
+ Cs = [cerl:c_clause([cerl:c_atom(true)], True),
+ cerl:c_clause([cerl:c_atom(false)], False)],
+ cerl:c_case(Test, Cs).
+-endif.
+
+%% A boolean switch cannot have a catch-all; only true/false branches.
+
+-spec is_bool_switch([cerl:c_clause()]) -> boolean().
+
+is_bool_switch([C1, C2]) ->
+ case is_simple_clause(C1) andalso is_simple_clause(C2) of
+ true ->
+ [P1] = cerl:clause_pats(C1),
+ [P2] = cerl:clause_pats(C2),
+ case cerl:is_c_atom(P1) andalso cerl:is_c_atom(P2) of
+ true ->
+ A1 = cerl:concrete(P1),
+ A2 = cerl:concrete(P2),
+ is_boolean(A1) andalso is_boolean(A2)
+ andalso A1 =/= A2;
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+is_bool_switch(_) ->
+ false.
+
+%% Returns the true-body and the false-body for boolean switch clauses.
+
+-spec bool_switch_cases([cerl:c_clause()]) -> {cerl:cerl(), cerl:cerl()}.
+
+bool_switch_cases([C1, C2]) ->
+ B1 = cerl:clause_body(C1),
+ B2 = cerl:clause_body(C2),
+ [P1] = cerl:clause_pats(C1),
+ case cerl:concrete(P1) of
+ true ->
+ {B1, B2};
+ false ->
+ {B2, B1}
+ end.
+
+%%
+%% The type of the check functions like the default check below - XXX: refine
+%%
+-type check_fun() :: fun((_, _) -> boolean()).
+
+%% The default function property check always returns `false':
+
+default_check(_Property, _Function) -> false.
+
+
+%% @spec is_safe_expr(Expr::cerl()) -> boolean()
+%%
+%% @doc Returns `true' if `Expr' represents a "safe" Core Erlang
+%% expression, otherwise `false'. An expression is safe if it always
+%% completes normally and does not modify the state (although the return
+%% value may depend on the state).
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered unsafe by this function.
+
+%% TODO: update cerl_inline to use these functions instead.
+
+-ifndef(NO_UNUSED).
+is_safe_expr(E) ->
+ Check = fun default_check/2,
+ is_safe_expr(E, Check).
+-endif.
+%% @clear
+
+-spec is_safe_expr(cerl:cerl(), check_fun()) -> boolean().
+
+is_safe_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_safe_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_safe_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_safe_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_safe_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_safe_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_safe_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_safe_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_safe_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ %% If the guarded expression is safe, the try-handler will
+ %% never be evaluated, so we need only check the body. If
+ %% the guarded expression is pure, but could fail, we also
+ %% have to check the handler.
+ case is_safe_expr(cerl:try_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_body(E), Check);
+ false ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_safe_expr(cerl:try_body(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(safe, {Name, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(safe, {M, F, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_safe_expr_list([E | Es], Check) ->
+ case is_safe_expr(E, Check) of
+ true ->
+ is_safe_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_safe_expr_list([], _Check) ->
+ true.
+
+
+%% @spec (Expr::cerl()) -> bool()
+%%
+%% @doc Returns `true' if `Expr' represents a "pure" Core Erlang
+%% expression, otherwise `false'. An expression is pure if it does not
+%% affect the state, nor depend on the state, although its evaluation is
+%% not guaranteed to complete normally for all input.
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered impure by this function.
+
+-ifndef(NO_UNUSED).
+is_pure_expr(E) ->
+ Check = fun default_check/2,
+ is_pure_expr(E, Check).
+-endif.
+%% @clear
+
+is_pure_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_pure_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_pure_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_pure_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_pure_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_pure_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_pure_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_pure_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_pure_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_pure_expr(cerl:try_body(E), Check) of
+ true ->
+ is_pure_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(pure, {Name, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(pure, {M, F, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_pure_expr_list([E | Es], Check) ->
+ case is_pure_expr(E, Check) of
+ true ->
+ is_pure_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_pure_expr_list([], _Check) ->
+ true.
+
+
+%% Peephole optimizations
+%%
+%% This is only intended to be a light-weight cleanup optimizer,
+%% removing small things that may e.g. have been generated by other
+%% optimization passes or in the translation from higher-level code.
+%% It is not recursive in general - it only descends until it can do no
+%% more work in the current context.
+%%
+%% To expose hidden cases of final expressions (enabling last call
+%% optimization), we try to remove all trivial let-bindings (`let X = Y
+%% in X', `let X = Y in Y', `let X = Y in let ... in ...', `let X = let
+%% ... in ... in ...', etc.). We do not, however, try to recognize any
+%% other similar cases, even for simple `case'-expressions like `case E
+%% of X -> X end', or simultaneous multiple-value bindings.
+
+-spec reduce_expr(cerl:cerl()) -> cerl:cerl().
+
+reduce_expr(E) ->
+ Check = fun default_check/2,
+ reduce_expr(E, Check).
+
+-spec reduce_expr(cerl:cerl(), check_fun()) -> cerl:cerl().
+
+reduce_expr(E, Check) ->
+ case cerl:type(E) of
+ values ->
+ case cerl:values_es(E) of
+ [E1] ->
+ %% Not really an "optimization" in itself, but
+ %% enables other rewritings by removing the wrapper.
+ reduce_expr(E1, Check);
+ _ ->
+ E
+ end;
+ 'seq' ->
+ A = reduce_expr(cerl:seq_arg(E), Check),
+ B = reduce_expr(cerl:seq_body(E), Check),
+ %% `do <E1> <E2>' is equivalent to `<E2>' if `<E1>' is
+ %% "safe" (cannot effect the behaviour in any way).
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ case cerl:is_c_seq(B) of
+ true ->
+ %% Rewrite `do <E1> do <E2> <E3>' to `do do
+ %% <E1> <E2> <E3>' so that the "body" of the
+ %% outermost seq-operator is the expression
+ %% which produces the final result (i.e.,
+ %% E3). This can make other optimizations
+ %% easier; see `let'.
+ B1 = cerl:seq_arg(B),
+ B2 = cerl:seq_body(B),
+ cerl:c_seq(cerl:c_seq(A, B1), B2);
+ false ->
+ cerl:c_seq(A, B)
+ end
+ end;
+ 'let' ->
+ A = reduce_expr(cerl:let_arg(E), Check),
+ case cerl:is_c_seq(A) of
+ true ->
+ %% `let X = do <E1> <E2> in Y' is equivalent to `do
+ %% <E1> let X = <E2> in Y'. Note that `<E2>' cannot
+ %% be a seq-operator, due to the `seq' optimization.
+ A1 = cerl:seq_arg(A),
+ A2 = cerl:seq_body(A),
+ E1 = cerl:update_c_let(E, cerl:let_vars(E),
+ A2, cerl:let_body(E)),
+ cerl:c_seq(A1, reduce_expr(E1, Check));
+ false ->
+ B = reduce_expr(cerl:let_body(E), Check),
+ Vs = cerl:let_vars(E),
+ %% We give up if the body does not reduce to a
+ %% single variable. This is not a generic copy
+ %% propagation.
+ case cerl:type(B) of
+ var when length(Vs) =:= 1 ->
+ %% We have `let <V1> = <E> in <V2>':
+ [V] = Vs,
+ N1 = cerl:var_name(V),
+ N2 = cerl:var_name(B),
+ if N1 =:= N2 ->
+ %% `let X = <E> in X' equals `<E>'
+ A;
+ true ->
+ %% `let X = <E> in Y' when X and Y
+ %% are different variables is
+ %% equivalent to `do <E> Y'.
+ reduce_expr(cerl:c_seq(A, B), Check)
+ end;
+ literal ->
+ %% `let X = <E> in T' when T is a literal
+ %% term is equivalent to `do <E> T'.
+ reduce_expr(cerl:c_seq(A, B), Check);
+ _ ->
+ cerl:update_c_let(E, Vs, A, B)
+ end
+ end;
+ 'try' ->
+ %% Get rid of unnecessary try-expressions.
+ A = reduce_expr(cerl:try_arg(E), Check),
+ B = reduce_expr(cerl:try_body(E), Check),
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_try(E, A, cerl:try_vars(E), B,
+ cerl:try_evars(E),
+ cerl:try_handler(E))
+ end;
+ 'catch' ->
+ %% Just a simpler form of try-expressions.
+ B = reduce_expr(cerl:catch_body(E), Check),
+ case is_safe_expr(B, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_catch(E, B)
+ end;
+ _ ->
+ E
+ end.
diff --git a/lib/dialyzer/src/cerl_pmatch.erl b/lib/dialyzer/src/cerl_pmatch.erl
new file mode 100644
index 0000000000..66fce3c8eb
--- /dev/null
+++ b/lib/dialyzer/src/cerl_pmatch.erl
@@ -0,0 +1,620 @@
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 2000-2006 Richard Carlsson
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%%
+%% @doc Core Erlang pattern matching compiler.
+%%
+%% <p>For reference, see Simon L. Peyton Jones "The Implementation of
+%% Functional Programming Languages", chapter 5 (by Phil Wadler).</p>
+%%
+%% @type cerl() = cerl:cerl().
+%% Abstract Core Erlang syntax trees.
+%% @type cerl_records() = cerl:cerl_records().
+%% An explicit record representation of Core Erlang syntax trees.
+
+-module(cerl_pmatch).
+
+%%-define(NO_UNUSED, true).
+
+-export([clauses/2]).
+-ifndef(NO_UNUSED).
+-export([transform/2, core_transform/2, expr/2]).
+-endif.
+
+-import(lists, [all/2, splitwith/2, foldr/3, keysort/2, foldl/3,
+ mapfoldl/3]).
+
+-define(binary_id, {binary}).
+-define(cons_id, {cons}).
+-define(tuple_id, {tuple}).
+-define(literal_id(V), V).
+
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Transforms a module represented by records. See
+%% <code>transform/2</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform, cerl_pmatch}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see transform/2
+
+-ifndef(NO_UNUSED).
+-spec core_transform(cerl:c_module(), [_]) -> cerl:c_module().
+
+core_transform(M, Opts) ->
+ cerl:to_records(transform(cerl:from_records(M), Opts)).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%% @doc Rewrites all <code>case</code>-clauses in <code>Module</code>.
+%% <code>receive</code>-clauses are not affected. Currently, no options
+%% are available.
+%%
+%% @see clauses/2
+%% @see expr/2
+%% @see core_transform/2
+
+-ifndef(NO_UNUSED).
+-spec transform(cerl:cerl(), [_]) -> cerl:cerl().
+
+transform(M, _Opts) ->
+ expr(M, env__empty()).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% @spec clauses(Clauses::[Clause], Env) -> {Expr, Vars}
+%% Clause = cerl()
+%% Expr = cerl()
+%% Vars = [cerl()]
+%% Env = rec_env:environment()
+%%
+%% @doc Rewrites a sequence of clauses to an equivalent expression,
+%% removing as much repeated testing as possible. Returns a pair
+%% <code>{Expr, Vars}</code>, where <code>Expr</code> is the resulting
+%% expression, and <code>Vars</code> is a list of new variables (i.e.,
+%% not already in the given environment) to be bound to the arguments to
+%% the switch. The following is a typical example (assuming
+%% <code>E</code> is a Core Erlang case expression):
+%% <pre>
+%% handle_case(E, Env) ->
+%% Cs = case_clauses(E),
+%% {E1, Vs} = cerl_pmatch(Cs, Env),
+%% c_let(Vs, case_arg(E), E1).
+%% </pre>
+%%
+%% <p>The environment is used for generating new variables which do not
+%% shadow existing bindings.</p>
+%%
+%% @see rec_env
+%% @see expr/2
+%% @see transform/2
+
+-spec clauses([cerl:cerl(),...], rec_env:environment()) ->
+ {cerl:cerl(), [cerl:cerl()]}.
+
+clauses(Cs, Env) ->
+ clauses(Cs, none, Env).
+
+clauses([C | _] = Cs, Else, Env) ->
+ Vs = new_vars(cerl:clause_arity(C), Env),
+ E = match(Vs, Cs, Else, add_vars(Vs, Env)),
+ {E, Vs}.
+
+%% The implementation very closely follows that described in the book.
+
+match([], Cs, Else, _Env) ->
+ %% If the "default action" is the atom 'none', it is simply not
+ %% added; otherwise it is put in the body of a final catch-all
+ %% clause (which is often removed by the below optimization).
+ Cs1 = if Else =:= none -> Cs;
+ true -> Cs ++ [cerl:c_clause([], Else)]
+ end,
+ %% This clause reduction is an important optimization. It selects a
+ %% clause body if possible, and otherwise just removes dead clauses.
+ case cerl_clauses:reduce(Cs1) of
+ {true, {C, []}} -> % if we get bindings, something is wrong!
+ cerl:clause_body(C);
+ {false, Cs2} ->
+ %% This happens when guards are nontrivial.
+ cerl:c_case(cerl:c_values([]), Cs2)
+ end;
+match([V | _] = Vs, Cs, Else, Env) ->
+ foldr(fun (CsF, ElseF) ->
+ match_var_con(Vs, CsF, ElseF, Env)
+ end,
+ Else,
+ group([unalias(C, V) || C <- Cs], fun is_var_clause/1)).
+
+group([], _F) ->
+ [];
+group([X | _] = Xs, F) ->
+ group(Xs, F, F(X)).
+
+group(Xs, F, P) ->
+ {First, Rest} = splitwith(fun (X) -> F(X) =:= P end, Xs),
+ [First | group(Rest, F)].
+
+is_var_clause(C) ->
+ cerl:is_c_var(hd(cerl:clause_pats(C))).
+
+%% To avoid code duplication, if the 'Else' expression is too big, we
+%% put it in a local function definition instead, and replace it with a
+%% call. (Note that it is important that 'is_lightweight' does not yield
+%% 'true' for a simple function application, or we will create a lot of
+%% unnecessary extra functions.)
+
+match_var_con(Vs, Cs, none = Else, Env) ->
+ match_var_con_1(Vs, Cs, Else, Env);
+match_var_con(Vs, Cs, Else, Env) ->
+ case is_lightweight(Else) of
+ true ->
+ match_var_con_1(Vs, Cs, Else, Env);
+ false ->
+ F = new_fvar("match_", 0, Env),
+ Else1 = cerl:c_apply(F, []),
+ Env1 = add_vars([F], Env),
+ cerl:c_letrec([{F, cerl:c_fun([], Else)}],
+ match_var_con_1(Vs, Cs, Else1, Env1))
+ end.
+
+match_var_con_1(Vs, Cs, Else, Env) ->
+ case is_var_clause(hd(Cs)) of
+ true ->
+ match_var(Vs, Cs, Else, Env);
+ false ->
+ match_con(Vs, Cs, Else, Env)
+ end.
+
+match_var([V | Vs], Cs, Else, Env) ->
+ Cs1 = [begin
+ [P | Ps] = cerl:clause_pats(C),
+ G = make_let([P], V, cerl:clause_guard(C)),
+ B = make_let([P], V, cerl:clause_body(C)),
+ cerl:update_c_clause(C, Ps, G, B)
+ end
+ || C <- Cs],
+ match(Vs, Cs1, Else, Env).
+
+%% Since Erlang is dynamically typed, we must include the possibility
+%% that none of the constructors in the group will match, and in that
+%% case the "Else" code will be executed (unless it is 'none'), in the
+%% body of a final catch-all clause.
+
+match_con([V | Vs], Cs, Else, Env) ->
+ case group_con(Cs) of
+ [{_, _, Gs}] ->
+ %% Don't create a group type switch if there is only one
+ %% such group
+ make_switch(V, [match_congroup(DG, Vs, CsG, Else, Env)
+ || {DG, _, CsG} <- Gs],
+ Else, Env);
+ Ts ->
+ Cs1 = [match_typegroup(T, V, Vs, Gs, Else, Env)
+ || {T, _, Gs} <- Ts],
+ make_switch(V, Cs1, Else, Env)
+ end.
+
+
+match_typegroup(_T, _V, Vs, [{D, _, Cs}], Else, Env) when element(1, D) /= ?binary_id ->
+ %% Don't create a group type switch if there is only one constructor
+ %% in the group. (Note that this always happens for '[]'.)
+ %% Special case for binaries which always get a group switch
+ match_congroup(D, Vs, Cs, Else, Env);
+match_typegroup(T, V, Vs, Gs, Else, Env) ->
+ Body = make_switch(V, [match_congroup(D, Vs, Cs, Else, Env)
+ || {D, _, Cs} <- Gs],
+ Else, Env),
+ typetest_clause(T, V, Body, Env).
+
+match_congroup({?binary_id, Segs}, Vs, Cs, Else, Env) ->
+ Body = match(Vs, Cs, Else, Env),
+ cerl:c_clause([make_pat(?binary_id, Segs)], Body);
+
+match_congroup({D, A}, Vs, Cs, Else, Env) ->
+ Vs1 = new_vars(A, Env),
+ Body = match(Vs1 ++ Vs, Cs, Else, add_vars(Vs1, Env)),
+ cerl:c_clause([make_pat(D, Vs1)], Body).
+
+make_switch(V, Cs, Else, Env) ->
+ cerl:c_case(V, if Else =:= none -> Cs;
+ true -> Cs ++ [cerl:c_clause([new_var(Env)],
+ Else)]
+ end).
+
+%% We preserve the relative order of different-type constructors as they
+%% were originally listed. This is done by tracking the clause numbers.
+
+group_con(Cs) ->
+ {Cs1, _} = mapfoldl(fun (C, N) ->
+ [P | Ps] = cerl:clause_pats(C),
+ Ps1 = sub_pats(P) ++ Ps,
+ G = cerl:clause_guard(C),
+ B = cerl:clause_body(C),
+ C1 = cerl:update_c_clause(C, Ps1, G, B),
+ D = con_desc(P),
+ {{D, N, C1}, N + 1}
+ end,
+ 0, Cs),
+ %% Sort and group constructors.
+ Css = group(keysort(1, Cs1), fun ({D,_,_}) -> D end),
+ %% Sort each group "back" by line number, and move the descriptor
+ %% and line number to the wrapper for the group.
+ Gs = [finalize_congroup(C) || C <- Css],
+ %% Group by type only (put e.g. different-arity tuples together).
+ Gss = group(Gs, fun ({D,_,_}) -> con_desc_type(D) end),
+ %% Sort and wrap the type groups.
+ Ts = [finalize_typegroup(G) || G <- Gss],
+ %% Sort type-groups by first clause order
+ keysort(2, Ts).
+
+finalize_congroup(Cs) ->
+ [{D,N,_}|_] = Cs1 = keysort(2, Cs),
+ {D, N, [C || {_,_,C} <- Cs1]}.
+
+finalize_typegroup(Gs) ->
+ [{D,N,_}|_] = Gs1 = keysort(2, Gs),
+ {con_desc_type(D), N, Gs1}.
+
+%% Since Erlang clause patterns can contain "alias patterns", we must
+%% eliminate these, by turning them into let-definitions in the guards
+%% and bodies of the clauses.
+
+unalias(C, V) ->
+ [P | Ps] = cerl:clause_pats(C),
+ B = cerl:clause_body(C),
+ G = cerl:clause_guard(C),
+ unalias(P, V, Ps, B, G, C).
+
+unalias(P, V, Ps, B, G, C) ->
+ case cerl:type(P) of
+ alias ->
+ V1 = cerl:alias_var(P),
+ B1 = make_let([V1], V, B),
+ G1 = make_let([V1], V, G),
+ unalias(cerl:alias_pat(P), V, Ps, B1, G1, C);
+ _ ->
+ cerl:update_c_clause(C, [P | Ps], G, B)
+ end.
+
+%% Generating a type-switch clause
+
+typetest_clause([], _V, E, _Env) ->
+ cerl:c_clause([cerl:c_nil()], E);
+typetest_clause(atom, V, E, _Env) ->
+ typetest_clause_1(is_atom, V, E);
+typetest_clause(integer, V, E, _Env) ->
+ typetest_clause_1(is_integer, V, E);
+typetest_clause(float, V, E, _Env) ->
+ typetest_clause_1(is_float, V, E);
+typetest_clause(cons, _V, E, Env) ->
+ [V1, V2] = new_vars(2, Env),
+ cerl:c_clause([cerl:c_cons(V1, V2)], E); % there is no 'is cons'
+typetest_clause(tuple, V, E, _Env) ->
+ typetest_clause_1(is_tuple, V, E);
+typetest_clause(binary, V, E, _Env) ->
+ typetest_clause_1(is_binary, V, E).
+
+typetest_clause_1(T, V, E) ->
+ cerl:c_clause([V], cerl:c_call(cerl:c_atom('erlang'),
+ cerl:c_atom(T), [V]), E).
+
+%% This returns a constructor descriptor, to be used for grouping and
+%% pattern generation. It consists of an identifier term and the arity.
+
+con_desc(E) ->
+ case cerl:type(E) of
+ cons -> {?cons_id, 2};
+ tuple -> {?tuple_id, cerl:tuple_arity(E)};
+ binary -> {?binary_id, cerl:binary_segments(E)};
+ literal ->
+ case cerl:concrete(E) of
+ [_|_] -> {?cons_id, 2};
+ T when is_tuple(T) -> {?tuple_id, tuple_size(T)};
+ V -> {?literal_id(V), 0}
+ end;
+ _ ->
+ throw({bad_constructor, E})
+ end.
+
+%% This returns the type class for a constructor descriptor, for
+%% grouping of clauses. It does not distinguish between tuples of
+%% different arity, nor between different values of atoms, integers and
+%% floats.
+
+con_desc_type({?literal_id([]), _}) -> [];
+con_desc_type({?literal_id(V), _}) when is_atom(V) -> atom;
+con_desc_type({?literal_id(V), _}) when is_integer(V) -> integer;
+con_desc_type({?literal_id(V), _}) when is_float(V) -> float;
+con_desc_type({?cons_id, 2}) -> cons;
+con_desc_type({?tuple_id, _}) -> tuple;
+con_desc_type({?binary_id, _}) -> binary.
+
+%% This creates a new constructor pattern from a type descriptor and a
+%% list of variables.
+
+make_pat(?cons_id, [V1, V2]) -> cerl:c_cons(V1, V2);
+make_pat(?tuple_id, Vs) -> cerl:c_tuple(Vs);
+make_pat(?binary_id, Segs) -> cerl:c_binary(Segs);
+make_pat(?literal_id(Val), []) -> cerl:abstract(Val).
+
+%% This returns the list of subpatterns of a constructor pattern.
+
+sub_pats(E) ->
+ case cerl:type(E) of
+ cons ->
+ [cerl:cons_hd(E), cerl:cons_tl(E)];
+ tuple ->
+ cerl:tuple_es(E);
+ binary ->
+ [];
+ literal ->
+ case cerl:concrete(E) of
+ [H|T] -> [cerl:abstract(H), cerl:abstract(T)];
+ T when is_tuple(T) -> [cerl:abstract(X)
+ || X <- tuple_to_list(T)];
+ _ -> []
+ end;
+ _ ->
+ throw({bad_constructor_pattern, E})
+ end.
+
+%% This avoids generating stupid things like "let X = ... in 'true'",
+%% and "let X = Y in X", keeping the generated code cleaner. It also
+%% prevents expressions from being considered "non-lightweight" when
+%% code duplication is disallowed (see is_lightweight for details).
+
+make_let(Vs, A, B) ->
+ cerl_lib:reduce_expr(cerl:c_let(Vs, A, B)).
+
+%% ---------------------------------------------------------------------
+%% Rewriting a module or other expression:
+
+%% @spec expr(Expression::cerl(), Env) -> cerl()
+%% Env = rec_env:environment()
+%%
+%% @doc Rewrites all <code>case</code>-clauses in
+%% <code>Expression</code>. <code>receive</code>-clauses are not
+%% affected.
+%%
+%% <p>The environment is used for generating new variables which do not
+%% shadow existing bindings.</p>
+%%
+%% @see clauses/2
+%% @see rec_env
+
+-ifndef(NO_UNUSED).
+-spec expr(cerl:cerl(), rec_env:environment()) -> cerl:cerl().
+
+expr(E, Env) ->
+ case cerl:type(E) of
+ binary ->
+ Es = expr_list(cerl:binary_segments(E), Env),
+ cerl:update_c_binary(E, Es);
+ bitstr ->
+ V = expr(cerl:bitstr_val(E), Env),
+ Sz = expr(cerl:bitstr_size(E), Env),
+ Unit = expr(cerl:bitstr_unit(E), Env),
+ Type = expr(cerl:bitstr_type(E), Env),
+ cerl:update_c_bitstr(E, V, Sz, Unit, Type, cerl:bitstr_flags(E));
+ literal ->
+ E;
+ var ->
+ E;
+ values ->
+ Es = expr_list(cerl:values_es(E), Env),
+ cerl:update_c_values(E, Es);
+ cons ->
+ H = expr(cerl:cons_hd(E), Env),
+ T = expr(cerl:cons_tl(E), Env),
+ cerl:update_c_cons(E, H, T);
+ tuple ->
+ Es = expr_list(cerl:tuple_es(E), Env),
+ cerl:update_c_tuple(E, Es);
+ 'let' ->
+ A = expr(cerl:let_arg(E), Env),
+ Vs = cerl:let_vars(E),
+ Env1 = add_vars(Vs, Env),
+ B = expr(cerl:let_body(E), Env1),
+ cerl:update_c_let(E, Vs, A, B);
+ seq ->
+ A = expr(cerl:seq_arg(E), Env),
+ B = expr(cerl:seq_body(E), Env),
+ cerl:update_c_seq(E, A, B);
+ apply ->
+ Op = expr(cerl:apply_op(E), Env),
+ As = expr_list(cerl:apply_args(E), Env),
+ cerl:update_c_apply(E, Op, As);
+ call ->
+ M = expr(cerl:call_module(E), Env),
+ N = expr(cerl:call_name(E), Env),
+ As = expr_list(cerl:call_args(E), Env),
+ cerl:update_c_call(E, M, N, As);
+ primop ->
+ As = expr_list(cerl:primop_args(E), Env),
+ cerl:update_c_primop(E, cerl:primop_name(E), As);
+ 'case' ->
+ A = expr(cerl:case_arg(E), Env),
+ Cs = expr_list(cerl:case_clauses(E), Env),
+ {E1, Vs} = clauses(Cs, Env),
+ make_let(Vs, A, E1);
+ clause ->
+ Vs = cerl:clause_vars(E),
+ Env1 = add_vars(Vs, Env),
+ G = expr(cerl:clause_guard(E), Env1),
+ B = expr(cerl:clause_body(E), Env1),
+ cerl:update_c_clause(E, cerl:clause_pats(E), G, B);
+ 'fun' ->
+ Vs = cerl:fun_vars(E),
+ Env1 = add_vars(Vs, Env),
+ B = expr(cerl:fun_body(E), Env1),
+ cerl:update_c_fun(E, Vs, B);
+ 'receive' ->
+ %% NOTE: No pattern matching compilation is done here! The
+ %% receive-clauses and patterns cannot be staged as long as
+ %% we are working with "normal" Core Erlang.
+ Cs = expr_list(cerl:receive_clauses(E), Env),
+ T = expr(cerl:receive_timeout(E), Env),
+ A = expr(cerl:receive_action(E), Env),
+ cerl:update_c_receive(E, Cs, T, A);
+ 'try' ->
+ A = expr(cerl:try_arg(E), Env),
+ Vs = cerl:try_vars(E),
+ B = expr(cerl:try_body(E), add_vars(Vs, Env)),
+ Evs = cerl:try_evars(E),
+ H = expr(cerl:try_handler(E), add_vars(Evs, Env)),
+ cerl:update_c_try(E, A, Vs, B, Evs, H);
+ 'catch' ->
+ B = expr(cerl:catch_body(E), Env),
+ cerl:update_c_catch(E, B);
+ letrec ->
+ Ds = cerl:letrec_defs(E),
+ Env1 = add_defs(Ds, Env),
+ Ds1 = defs(Ds, Env1),
+ B = expr(cerl:letrec_body(E), Env1),
+ cerl:update_c_letrec(E, Ds1, B);
+ module ->
+ Ds = cerl:module_defs(E),
+ Env1 = add_defs(Ds, Env),
+ Ds1 = defs(Ds, Env1),
+ cerl:update_c_module(E, cerl:module_name(E),
+ cerl:module_exports(E),
+ cerl:module_attrs(E), Ds1)
+ end.
+
+expr_list(Es, Env) ->
+ [expr(E, Env) || E <- Es].
+
+defs(Ds, Env) ->
+ [{V, expr(F, Env)} || {V, F} <- Ds].
+-endif. % NO_UNUSED
+%% @clear
+
+%% ---------------------------------------------------------------------
+%% Support functions
+
+new_var(Env) ->
+ Name = env__new_vname(Env),
+ cerl:c_var(Name).
+
+new_vars(N, Env) ->
+ [cerl:c_var(V) || V <- env__new_vnames(N, Env)].
+
+new_fvar(A, N, Env) ->
+ Name = env__new_fname(A, N, Env),
+ cerl:c_var(Name).
+
+add_vars(Vs, Env) ->
+ foldl(fun (V, E) -> env__bind(cerl:var_name(V), [], E) end, Env, Vs).
+
+-ifndef(NO_UNUSED).
+add_defs(Ds, Env) ->
+ foldl(fun ({V, _F}, E) ->
+ env__bind(cerl:var_name(V), [], E)
+ end, Env, Ds).
+-endif. % NO_UNUSED
+
+%% This decides whether an expression is worth lifting out to a separate
+%% function instead of duplicating the code. In other words, whether its
+%% cost is about the same or smaller than that of a local function call.
+%% Note that variables must always be "lightweight"; otherwise, they may
+%% get lifted out of the case switch that introduces them.
+
+is_lightweight(E) ->
+ case get('cerl_pmatch_duplicate_code') of
+ never -> cerl:type(E) =:= var; % Avoids all code duplication
+ always -> true; % Does not lift code to new functions
+ _ -> is_lightweight_1(E)
+ end.
+
+is_lightweight_1(E) ->
+ case cerl:type(E) of
+ var -> true;
+ literal -> true;
+ 'fun' -> true;
+ values -> all(fun is_simple/1, cerl:values_es(E));
+ cons -> is_simple(cerl:cons_hd(E))
+ andalso is_simple(cerl:cons_tl(E));
+ tuple -> all(fun is_simple/1, cerl:tuple_es(E));
+ 'let' -> (is_simple(cerl:let_arg(E)) andalso
+ is_lightweight_1(cerl:let_body(E)));
+ seq -> (is_simple(cerl:seq_arg(E)) andalso
+ is_lightweight_1(cerl:seq_body(E)));
+ primop ->
+ all(fun is_simple/1, cerl:primop_args(E));
+ apply ->
+ is_simple(cerl:apply_op(E))
+ andalso all(fun is_simple/1, cerl:apply_args(E));
+ call ->
+ is_simple(cerl:call_module(E))
+ andalso is_simple(cerl:call_name(E))
+ andalso all(fun is_simple/1, cerl:call_args(E));
+ _ ->
+ %% The default is to lift the code to a new function.
+ false
+ end.
+
+%% "Simple" things have no (or negligible) runtime cost and are free
+%% from side effects.
+
+is_simple(E) ->
+ case cerl:type(E) of
+ var -> true;
+ literal -> true;
+ values -> all(fun is_simple/1, cerl:values_es(E));
+ _ -> false
+ end.
+
+
+%% ---------------------------------------------------------------------
+%% Abstract datatype: environment()
+
+env__bind(Key, Val, Env) ->
+ rec_env:bind(Key, Val, Env).
+
+-ifndef(NO_UNUSED).
+%% env__bind_recursive(Ks, Vs, F, Env) ->
+%% rec_env:bind_recursive(Ks, Vs, F, Env).
+
+%% env__lookup(Key, Env) ->
+%% rec_env:lookup(Key, Env).
+
+%% env__get(Key, Env) ->
+%% rec_env:get(Key, Env).
+
+%% env__is_defined(Key, Env) ->
+%% rec_env:is_defined(Key, Env).
+
+env__empty() ->
+ rec_env:empty().
+-endif. % NO_UNUSED
+
+env__new_vname(Env) ->
+ rec_env:new_key(Env).
+
+env__new_vnames(N, Env) ->
+ rec_env:new_keys(N, Env).
+
+env__new_fname(F, A, Env) ->
+ rec_env:new_key(fun (X) ->
+ S = integer_to_list(X),
+ {list_to_atom(F ++ S), A}
+ end,
+ Env).
diff --git a/lib/dialyzer/src/cerl_prettypr.erl b/lib/dialyzer/src/cerl_prettypr.erl
new file mode 100644
index 0000000000..46193276d4
--- /dev/null
+++ b/lib/dialyzer/src/cerl_prettypr.erl
@@ -0,0 +1,910 @@
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @doc Core Erlang prettyprinter.
+%%
+%% <p>This module is a front end to the pretty-printing library module
+%% <code>prettypr</code>, for text formatting of Core Erlang abstract
+%% syntax trees defined by the module <code>cerl</code>.</p>
+
+%% TODO: add printing of comments for `comment'-annotations?
+
+-module(cerl_prettypr).
+
+-define(NO_UNUSED, true).
+
+-export([format/1, format/2, annotate/3]).
+-ifndef(NO_UNUSED).
+-export([best/1, best/2, layout/1, layout/2, get_ctxt_paperwidth/1,
+ set_ctxt_paperwidth/2, get_ctxt_linewidth/1,
+ set_ctxt_linewidth/2, get_ctxt_hook/1, set_ctxt_hook/2,
+ get_ctxt_user/1, set_ctxt_user/2]).
+-endif.
+
+-import(prettypr, [text/1, nest/2, above/2, beside/2, sep/1, par/1,
+ par/2, follow/3, follow/2, floating/1, empty/0]).
+
+-import(cerl, [abstract/1, alias_pat/1, alias_var/1, apply_args/1,
+ apply_op/1, atom_lit/1, binary_segments/1, bitstr_val/1,
+ bitstr_size/1, bitstr_unit/1, bitstr_type/1,
+ bitstr_flags/1, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, c_atom/1,
+ c_binary/1, c_bitstr/5, c_int/1, clause_body/1,
+ clause_guard/1, clause_pats/1, concrete/1, cons_hd/1,
+ cons_tl/1, float_lit/1, fun_body/1, fun_vars/1,
+ get_ann/1, int_lit/1, is_c_cons/1, is_c_let/1,
+ is_c_nil/1, is_c_seq/1, is_print_string/1, let_arg/1,
+ let_body/1, let_vars/1, letrec_body/1, letrec_defs/1,
+ module_attrs/1, module_defs/1, module_exports/1,
+ module_name/1, primop_args/1, primop_name/1,
+ receive_action/1, receive_clauses/1, receive_timeout/1,
+ seq_arg/1, seq_body/1, string_lit/1, try_arg/1,
+ try_body/1, try_vars/1, try_evars/1, try_handler/1,
+ tuple_es/1, type/1, values_es/1, var_name/1,
+ map_arg/1, map_es/1, is_c_map_empty/1,
+ map_pair_key/1, map_pair_val/1, map_pair_op/1
+ ]).
+
+-define(PAPER, 76).
+-define(RIBBON, 45).
+-define(NOUSER, undefined).
+-define(NOHOOK, none).
+
+-type hook() :: 'none' | fun((cerl:cerl(), _, _) -> prettypr:document()).
+
+-record(ctxt, {line = 0 :: integer(),
+ body_indent = 4 :: non_neg_integer(),
+ sub_indent = 2 :: non_neg_integer(),
+ hook = ?NOHOOK :: hook(),
+ noann = false :: boolean(),
+ paper = ?PAPER :: integer(),
+ ribbon = ?RIBBON :: integer(),
+ user = ?NOUSER :: term()}).
+-type context() :: #ctxt{}.
+
+%% =====================================================================
+%% The following functions examine and modify contexts:
+
+%% @spec (context()) -> integer()
+%% @doc Returns the paper widh field of the prettyprinter context.
+%% @see set_ctxt_paperwidth/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_paperwidth(Ctxt) ->
+ Ctxt#ctxt.paper.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), integer()) -> context()
+%%
+%% @doc Updates the paper widh field of the prettyprinter context.
+%%
+%% <p> Note: changing this value (and passing the resulting context to a
+%% continuation function) does not affect the normal formatting, but may
+%% affect user-defined behaviour in hook functions.</p>
+%%
+%% @see get_ctxt_paperwidth/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_paperwidth(Ctxt, W) ->
+ Ctxt#ctxt{paper = W}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> integer()
+%% @doc Returns the line widh field of the prettyprinter context.
+%% @see set_ctxt_linewidth/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_linewidth(Ctxt) ->
+ Ctxt#ctxt.ribbon.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), integer()) -> context()
+%%
+%% @doc Updates the line widh field of the prettyprinter context.
+%%
+%% <p> Note: changing this value (and passing the resulting context to a
+%% continuation function) does not affect the normal formatting, but may
+%% affect user-defined behaviour in hook functions.</p>
+%%
+%% @see get_ctxt_linewidth/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_linewidth(Ctxt, W) ->
+ Ctxt#ctxt{ribbon = W}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> hook()
+%% @doc Returns the hook function field of the prettyprinter context.
+%% @see set_ctxt_hook/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_hook(Ctxt) ->
+ Ctxt#ctxt.hook.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), hook()) -> context()
+%% @doc Updates the hook function field of the prettyprinter context.
+%% @see get_ctxt_hook/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_hook(Ctxt, Hook) ->
+ Ctxt#ctxt{hook = Hook}.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context()) -> term()
+%% @doc Returns the user data field of the prettyprinter context.
+%% @see set_ctxt_user/2
+
+-ifndef(NO_UNUSED).
+get_ctxt_user(Ctxt) ->
+ Ctxt#ctxt.user.
+-endif. % NO_UNUSED
+%% @clear
+
+%% @spec (context(), term()) -> context()
+%% @doc Updates the user data field of the prettyprinter context.
+%% @see get_ctxt_user/1
+
+-ifndef(NO_UNUSED).
+set_ctxt_user(Ctxt, X) ->
+ Ctxt#ctxt{user = X}.
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec format(Tree::cerl()) -> string()
+%% @equiv format(Tree, [])
+
+-spec format(cerl:cerl()) -> string().
+
+format(Node) ->
+ format(Node, []).
+
+
+%% =====================================================================
+%% @spec format(Tree::cerl(), Options::[term()]) -> string()
+%% cerl() = cerl:cerl()
+%%
+%% @type hook() = (cerl(), context(), Continuation) -> document()
+%% Continuation = (cerl(), context()) -> document().
+%%
+%% A call-back function for user-controlled formatting. See <a
+%% href="#format-2"><code>format/2</code></a>.
+%%
+%% @type context(). A representation of the current context of the
+%% pretty-printer. Can be accessed in hook functions.
+%%
+%% @doc Prettyprint-formats a Core Erlang syntax tree as text.
+%%
+%% <p>Available options:
+%% <dl>
+%% <dt>{hook, none | <a href="#type-hook">hook()</a>}</dt>
+%% <dd>Unless the value is <code>none</code>, the given function
+%% is called for every node; see below for details. The default
+%% value is <code>none</code>.</dd>
+%%
+%% <dt>{noann, boolean()}</dt>
+%% <dd>If the value is <code>true</code>, annotations on the code
+%% are not printed. The default value is <code>false</code>.</dd>
+%%
+%% <dt>{paper, integer()}</dt>
+%% <dd>Specifies the preferred maximum number of characters on any
+%% line, including indentation. The default value is 76.</dd>
+%%
+%% <dt>{ribbon, integer()}</dt>
+%% <dd>Specifies the preferred maximum number of characters on any
+%% line, not counting indentation. The default value is 45.</dd>
+%%
+%% <dt>{user, term()}</dt>
+%% <dd>User-specific data for use in hook functions. The default
+%% value is <code>undefined</code>.</dd>
+%% </dl></p>
+%%
+%% <p>A hook function (cf. the <a
+%% href="#type-hook"><code>hook()</code></a> type) is passed the current
+%% syntax tree node, the context, and a continuation. The context can be
+%% examined and manipulated by functions such as
+%% <code>get_ctxt_user/1</code> and <code>set_ctxt_user/2</code>. The
+%% hook must return a "document" data structure (see
+%% <code>layout/2</code> and <code>best/2</code>); this may be
+%% constructed in part or in whole by applying the continuation
+%% function. For example, the following is a trivial hook:
+%% <pre>
+%% fun (Node, Ctxt, Cont) -> Cont(Node, Ctxt) end
+%% </pre>
+%% which yields the same result as if no hook was given.
+%% The following, however:
+%% <pre>
+%% fun (Node, Ctxt, Cont) ->
+%% Doc = Cont(Node, Ctxt),
+%% prettypr:beside(prettypr:text("&lt;b>"),
+%% prettypr:beside(Doc,
+%% prettypr:text("&lt;/b>")))
+%% end
+%% </pre>
+%% will place the text of any annotated node (regardless of the
+%% annotation data) between HTML "boldface begin" and "boldface end"
+%% tags. The function <code>annotate/3</code> is exported for use in
+%% hook functions.</p>
+%%
+%% @see cerl
+%% @see format/1
+%% @see layout/2
+%% @see best/2
+%% @see annotate/3
+%% @see get_ctxt_user/1
+%% @see set_ctxt_user/2
+
+-spec format(cerl:cerl(), [term()]) -> string().
+
+format(Node, Options) ->
+ W = proplists:get_value(paper, Options, ?PAPER),
+ L = proplists:get_value(ribbon, Options, ?RIBBON),
+ prettypr:format(layout(Node, Options), W, L).
+
+
+%% =====================================================================
+%% @spec best(Tree::cerl()) -> empty | document()
+%% @equiv best(Node, [])
+
+-ifndef(NO_UNUSED).
+best(Node) ->
+ best(Node, []).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec best(Tree::cerl(), Options::[term()]) ->
+%% empty | document()
+%%
+%% @doc Creates a fixed "best" abstract layout for a Core Erlang syntax
+%% tree. This is similar to the <code>layout/2</code> function, except
+%% that here, the final layout has been selected with respect to the
+%% given options. The atom <code>empty</code> is returned if no such
+%% layout could be produced. For information on the options, see the
+%% <code>format/2</code> function.
+%%
+%% @see best/1
+%% @see layout/2
+%% @see format/2
+%% @see prettypr:best/2
+
+-ifndef(NO_UNUSED).
+best(Node, Options) ->
+ W = proplists:get_value(paper, Options, ?PAPER),
+ L = proplists:get_value(ribbon, Options, ?RIBBON),
+ prettypr:best(layout(Node, Options), W, L).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec layout(Tree::cerl()) -> document()
+%% @equiv layout(Tree, [])
+
+-ifndef(NO_UNUSED).
+layout(Node) ->
+ layout(Node, []).
+-endif. % NO_UNUSED
+%% @clear
+
+
+%% =====================================================================
+%% @spec annotate(document(), Terms::[term()], context()) -> document()
+%%
+%% @doc Adds an annotation containing <code>Terms</code> around the
+%% given abstract document. This function is exported mainly for use in
+%% hook functions; see <code>format/2</code>.
+%%
+%% @see format/2
+
+-spec annotate(prettypr:document(), [term()], context()) -> prettypr:document().
+
+annotate(Doc, As0, Ctxt) ->
+ case strip_line(As0) of
+ [] ->
+ Doc;
+ As ->
+ case Ctxt#ctxt.noann of
+ false ->
+ Es = seq(As, floating(text(",")), Ctxt,
+ fun lay_concrete/2),
+ follow(beside(floating(text("(")), Doc),
+ beside(text("-| ["),
+ beside(par(Es), floating(text("])")))),
+ Ctxt#ctxt.sub_indent);
+ true ->
+ Doc
+ end
+ end.
+
+
+%% =====================================================================
+%% @spec layout(Tree::cerl(), Options::[term()]) -> document()
+%% document() = prettypr:document()
+%%
+%% @doc Creates an abstract document layout for a syntax tree. The
+%% result represents a set of possible layouts (cf. module
+%% <code>prettypr</code>). For information on the options, see
+%% <code>format/2</code>; note, however, that the <code>paper</code> and
+%% <code>ribbon</code> options are ignored by this function.
+%%
+%% <p>This function provides a low-level interface to the pretty
+%% printer, returning a flexible representation of possible layouts,
+%% independent of the paper width eventually to be used for formatting.
+%% This can be included as part of another document and/or further
+%% processed directly by the functions in the <code>prettypr</code>
+%% module, or used in a hook function (see <code>format/2</code> for
+%% details).</p>
+%%
+%% @see prettypr
+%% @see format/2
+%% @see layout/1
+
+-spec layout(cerl:cerl(), [term()]) -> prettypr:document().
+
+layout(Node, Options) ->
+ lay(Node,
+ #ctxt{hook = proplists:get_value(hook, Options, ?NOHOOK),
+ noann = proplists:get_bool(noann, Options),
+ paper = proplists:get_value(paper, Options, ?PAPER),
+ ribbon = proplists:get_value(ribbon, Options, ?RIBBON),
+ user = proplists:get_value(user, Options)}).
+
+lay(Node, Ctxt) ->
+ case get_line(get_ann(Node)) of
+ none ->
+ lay_0(Node, Ctxt);
+ Line ->
+ if Line > Ctxt#ctxt.line ->
+ Ctxt1 = Ctxt#ctxt{line = Line},
+ Txt = io_lib:format("% Line ~w",[Line]),
+% beside(lay_0(Node, Ctxt1), floating(text(Txt)));
+ above(floating(text(Txt)), lay_0(Node, Ctxt1));
+ true ->
+ lay_0(Node, Ctxt)
+ end
+ end.
+
+lay_0(Node, Ctxt) ->
+ case Ctxt#ctxt.hook of
+ ?NOHOOK ->
+ lay_ann(Node, Ctxt);
+ Hook ->
+ %% If there is a hook, we apply it.
+ Hook(Node, Ctxt, fun lay_ann/2)
+ end.
+
+%% This adds an annotation list (if nonempty) around a document, unless
+%% the `noann' option is enabled.
+
+lay_ann(Node, Ctxt) ->
+ Doc = lay_1(Node, Ctxt),
+ As = get_ann(Node),
+ annotate(Doc, As, Ctxt).
+
+%% This part ignores annotations:
+
+lay_1(Node, Ctxt) ->
+ case type(Node) of
+ literal ->
+ lay_literal(Node, Ctxt);
+ var ->
+ lay_var(Node, Ctxt);
+ values ->
+ lay_values(Node, Ctxt);
+ cons ->
+ lay_cons(Node, Ctxt);
+ tuple ->
+ lay_tuple(Node, Ctxt);
+ map ->
+ lay_map(Node, Ctxt);
+ map_pair ->
+ lay_map_pair(Node, Ctxt);
+ 'let' ->
+ lay_let(Node, Ctxt);
+ seq ->
+ lay_seq(Node, Ctxt);
+ apply ->
+ lay_apply(Node, Ctxt);
+ call ->
+ lay_call(Node, Ctxt);
+ primop ->
+ lay_primop(Node, Ctxt);
+ 'case' ->
+ lay_case(Node, Ctxt);
+ clause ->
+ lay_clause(Node, Ctxt);
+ alias ->
+ lay_alias(Node, Ctxt);
+ 'fun' ->
+ lay_fun(Node, Ctxt);
+ 'receive' ->
+ lay_receive(Node, Ctxt);
+ 'try' ->
+ lay_try(Node, Ctxt);
+ 'catch' ->
+ lay_catch(Node, Ctxt);
+ letrec ->
+ lay_letrec(Node, Ctxt);
+ module ->
+ lay_module(Node, Ctxt);
+ binary ->
+ lay_binary(Node, Ctxt);
+ bitstr ->
+ lay_bitstr(Node, Ctxt)
+ end.
+
+lay_literal(Node, Ctxt) ->
+ case concrete(Node) of
+ V when is_atom(V) ->
+ text(atom_lit(Node));
+ V when is_float(V) ->
+ text(tidy_float(float_lit(Node)));
+ V when is_integer(V) ->
+ %% Note that we do not even try to recognize values
+ %% that could represent printable characters - we
+ %% always print an integer.
+ text(int_lit(Node));
+ V when is_bitstring(V) ->
+ Val = fun(I) when is_integer(I) -> I;
+ (B) when is_bitstring(B) ->
+ BZ = bit_size(B), <<BV:BZ>> = B, BV
+ end,
+ Sz = fun(I) when is_integer(I) -> 8;
+ (B) when is_bitstring(B) -> bit_size(B)
+ end,
+ lay_binary(c_binary([c_bitstr(abstract(Val(B)),
+ abstract(Sz(B)),
+ abstract(1),
+ abstract(integer),
+ abstract([unsigned, big]))
+ || B <- bitstring_to_list(V)]),
+ Ctxt);
+ [] ->
+ text("[]");
+ [_ | _] ->
+ %% `lay_cons' will check for strings.
+ lay_cons(Node, Ctxt);
+ V when is_tuple(V) ->
+ lay_tuple(Node, Ctxt);
+ M when is_map(M) ->
+ lay_map(Node, Ctxt)
+ end.
+
+lay_var(Node, Ctxt) ->
+ %% When formatting variable names, no two names should ever map to
+ %% the same string. We assume below that an atom representing a
+ %% variable name either has the character sequence of a proper
+ %% variable, or otherwise does not need single-quoting.
+ case var_name(Node) of
+ V when is_atom(V) ->
+ S = atom_to_list(V),
+ case S of
+ [C | _] when C >= $A, C =< $Z ->
+ %% Ordinary uppercase-prefixed names are printed
+ %% just as they are.
+ text(S);
+ [C | _] when C >= $\300, C =< $\336, C /= $\327 ->
+ %% These are also uppercase (ISO 8859-1).
+ text(S);
+ [$_| _] ->
+ %% If the name starts with '_' we keep the name as is.
+ text(S);
+ _ ->
+ %% Plain atom names are prefixed with a single "_".
+ %% E.g. 'foo' => "_foo".
+ text([$_ | S])
+ end;
+ V when is_integer(V) ->
+ %% Integers are always simply prefixed with "_";
+ %% e.g. 4711 => "_4711".
+ text([$_ | integer_to_list(V)]);
+ {N, A} when is_atom(N), is_integer(A) ->
+ %% Function names have no overlap problem.
+ beside(lay_noann(c_atom(atom_to_list(N)), Ctxt),
+ beside(text("/"), lay_noann(c_int(A), Ctxt)))
+ end.
+
+lay_values(Node, Ctxt) ->
+ lay_value_list(values_es(Node), Ctxt).
+
+lay_cons(Node, Ctxt) ->
+ case is_print_string(Node) of
+ true ->
+ lay_string(string_lit(Node), Ctxt);
+ false ->
+ beside(floating(text("[")),
+ beside(par(lay_list_elements(Node, Ctxt)),
+ floating(text("]"))))
+ end.
+
+lay_string(S, Ctxt) ->
+ %% S includes leading/trailing double-quote characters. The segment
+ %% width is 2/3 of the ribbon width - this seems to work well.
+ W = (Ctxt#ctxt.ribbon) * 2 div 3,
+ lay_string_1(S, length(S), W).
+
+lay_string_1(S, L, W) when L > W, W > 0 ->
+ %% Note that L is the minimum, not the exact, printed length.
+ case split_string(S, W - 1, L) of
+ {_, ""} ->
+ text(S);
+ {S1, S2} ->
+ above(text(S1 ++ "\""),
+ lay_string_1([$" | S2], L - W + 1, W))
+ end;
+lay_string_1(S, _L, _W) ->
+ text(S).
+
+split_string(Xs, N, L) ->
+ split_string_1(Xs, N, L, []).
+
+%% We only split strings at whitespace, if possible. We must make sure
+%% we do not split an escape sequence.
+
+split_string_1([$\s | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$\s | As]), Xs};
+split_string_1([$\t | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$t, $\\ | As]), Xs};
+split_string_1([$\n | Xs], N, L, As) when N =< 0, L >= 5 ->
+ {lists:reverse([$n, $\\ | As]), Xs};
+split_string_1([$\\ | Xs], N, L, As) ->
+ split_string_2(Xs, N - 1, L - 1, [$\\ | As]);
+split_string_1(Xs, N, L, As) when N =< -10, L >= 5 ->
+ {lists:reverse(As), Xs};
+split_string_1([X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 1, L - 1, [X | As]);
+split_string_1([], _N, _L, As) ->
+ {lists:reverse(As), ""}.
+
+split_string_2([$^, X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 2, L - 2, [X, $^ | As]);
+split_string_2([X1, X2, X3 | Xs], N, L, As) when
+ X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7, X3 >= $0, X3 =< $7 ->
+ split_string_1(Xs, N - 3, L - 3, [X3, X2, X1 | As]);
+split_string_2([X1, X2 | Xs], N, L, As) when
+ X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7 ->
+ split_string_1(Xs, N - 2, L - 2, [X2, X1 | As]);
+split_string_2([X | Xs], N, L, As) ->
+ split_string_1(Xs, N - 1, L - 1, [X | As]).
+
+lay_tuple(Node, Ctxt) ->
+ beside(floating(text("{")),
+ beside(par(seq(tuple_es(Node), floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text("}")))).
+
+lay_map(Node, Ctxt) ->
+ Arg = map_arg(Node),
+ After = case is_c_map_empty(Arg) of
+ true -> floating(text("}~"));
+ false ->
+ beside(floating(text(" | ")),
+ beside(lay(Arg,Ctxt),
+ floating(text("}~"))))
+ end,
+ beside(floating(text("~{")),
+ beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)),
+ After)).
+
+lay_map_pair(Node, Ctxt) ->
+ K = map_pair_key(Node),
+ V = map_pair_val(Node),
+ OpTxt = case concrete(map_pair_op(Node)) of
+ assoc -> "=>";
+ exact -> ":="
+ end,
+ beside(lay(K,Ctxt),beside(floating(text(OpTxt)),lay(V,Ctxt))).
+
+lay_let(Node, Ctxt) ->
+ V = lay_value_list(let_vars(Node), Ctxt),
+ D1 = par([follow(text("let"),
+ beside(V, floating(text(" ="))),
+ Ctxt#ctxt.sub_indent),
+ lay(let_arg(Node), Ctxt)],
+ Ctxt#ctxt.body_indent),
+ B = let_body(Node),
+ D2 = lay(B, Ctxt),
+ case is_c_let(B) of
+ true ->
+ sep([beside(D1, floating(text(" in"))), D2]);
+ false ->
+ sep([D1, beside(text("in "), D2)])
+ end.
+
+lay_seq(Node, Ctxt) ->
+ D1 = beside(text("do "), lay(seq_arg(Node), Ctxt)),
+ B = seq_body(Node),
+ D2 = lay(B, Ctxt),
+ case is_c_seq(B) of
+ true ->
+ sep([D1, D2]);
+ false ->
+ sep([D1, nest(3, D2)])
+ end.
+
+lay_apply(Node, Ctxt) ->
+ As = seq(apply_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("apply"), lay(apply_op(Node), Ctxt)),
+ beside(text("("),
+ beside(par(As), floating(text(")"))))).
+
+lay_call(Node, Ctxt) ->
+ As = seq(call_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("call"),
+ beside(beside(lay(call_module(Node), Ctxt),
+ floating(text(":"))),
+ lay(call_name(Node), Ctxt)),
+ Ctxt#ctxt.sub_indent),
+ beside(text("("), beside(par(As),
+ floating(text(")"))))).
+
+lay_primop(Node, Ctxt) ->
+ As = seq(primop_args(Node), floating(text(",")), Ctxt,
+ fun lay/2),
+ beside(follow(text("primop"),
+ lay(primop_name(Node), Ctxt),
+ Ctxt#ctxt.sub_indent),
+ beside(text("("), beside(par(As),
+ floating(text(")"))))).
+
+lay_case(Node, Ctxt) ->
+ Cs = seq(case_clauses(Node), none, Ctxt, fun lay/2),
+ sep([par([follow(text("case"),
+ lay(case_arg(Node), Ctxt),
+ Ctxt#ctxt.sub_indent),
+ text("of")],
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ vertical(Cs)),
+ text("end")]).
+
+lay_clause(Node, Ctxt) ->
+ P = lay_value_list(clause_pats(Node), Ctxt),
+ G = lay(clause_guard(Node), Ctxt),
+ H = par([P, follow(follow(text("when"), G,
+ Ctxt#ctxt.sub_indent),
+ floating(text("->")))],
+ Ctxt#ctxt.sub_indent),
+ par([H, lay(clause_body(Node), Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_alias(Node, Ctxt) ->
+ follow(beside(lay(alias_var(Node), Ctxt),
+ text(" =")),
+ lay(alias_pat(Node), Ctxt),
+ Ctxt#ctxt.body_indent).
+
+lay_fun(Node, Ctxt) ->
+ Vs = seq(fun_vars(Node), floating(text(",")),
+ Ctxt, fun lay/2),
+ par([follow(text("fun"),
+ beside(text("("),
+ beside(par(Vs),
+ floating(text(") ->")))),
+ Ctxt#ctxt.sub_indent),
+ lay(fun_body(Node), Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_receive(Node, Ctxt) ->
+ Cs = seq(receive_clauses(Node), none, Ctxt, fun lay/2),
+ sep([text("receive"),
+ nest(Ctxt#ctxt.sub_indent, vertical(Cs)),
+ sep([follow(text("after"),
+ beside(lay(receive_timeout(Node), Ctxt),
+ floating(text(" ->"))),
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ lay(receive_action(Node), Ctxt))])]).
+
+lay_try(Node, Ctxt) ->
+ Vs = lay_value_list(try_vars(Node), Ctxt),
+ Evs = lay_value_list(try_evars(Node), Ctxt),
+ sep([follow(text("try"),
+ lay(try_arg(Node), Ctxt),
+ Ctxt#ctxt.body_indent),
+ follow(beside(beside(text("of "), Vs),
+ floating(text(" ->"))),
+ lay(try_body(Node), Ctxt),
+ Ctxt#ctxt.body_indent),
+ follow(beside(beside(text("catch "), Evs),
+ floating(text(" ->"))),
+ lay(try_handler(Node), Ctxt),
+ Ctxt#ctxt.body_indent)]).
+
+lay_catch(Node, Ctxt) ->
+ follow(text("catch"),
+ lay(catch_body(Node), Ctxt),
+ Ctxt#ctxt.sub_indent).
+
+lay_letrec(Node, Ctxt) ->
+ Es = seq(letrec_defs(Node), none, Ctxt, fun lay_fdef/2),
+ sep([text("letrec"),
+ nest(Ctxt#ctxt.sub_indent, vertical(Es)),
+ beside(text("in "), lay(letrec_body(Node), Ctxt))]).
+
+lay_module(Node, Ctxt) ->
+ %% Note that the module name, exports and attributes may not
+ %% be annotated in the printed format.
+ Xs = seq(module_exports(Node), floating(text(",")), Ctxt,
+ fun lay_noann/2),
+ As = seq(module_attrs(Node), floating(text(",")), Ctxt,
+ fun lay_attrdef/2),
+ Es = seq(module_defs(Node), none, Ctxt, fun lay_fdef/2),
+ sep([follow(text("module"),
+ follow(lay_noann(module_name(Node), Ctxt),
+ beside(beside(text("["), par(Xs)),
+ floating(text("]")))),
+ Ctxt#ctxt.sub_indent),
+ nest(Ctxt#ctxt.sub_indent,
+ follow(text("attributes"),
+ beside(beside(text("["), par(As)),
+ floating(text("]"))),
+ Ctxt#ctxt.sub_indent)),
+ nest(Ctxt#ctxt.sub_indent, vertical(Es)),
+ text("end")]).
+
+lay_binary(Node, Ctxt) ->
+ beside(floating(text("#{")),
+ beside(sep(seq(binary_segments(Node), floating(text(",")),
+ Ctxt, fun lay_bitstr/2)),
+ floating(text("}#")))).
+
+lay_bitstr(Node, Ctxt) ->
+ Head = beside(floating(text("#<")),
+ beside(lay(bitstr_val(Node), Ctxt),
+ floating(text(">")))),
+ As = [bitstr_size(Node),
+ bitstr_unit(Node),
+ bitstr_type(Node),
+ bitstr_flags(Node)],
+ beside(Head, beside(floating(text("(")),
+ beside(sep(seq(As, floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text(")"))))).
+
+%% In all places where "<...>"-sequences can occur, it is OK to
+%% write 1-element sequences without the "<" and ">".
+
+lay_value_list([E], Ctxt) ->
+ lay(E, Ctxt);
+lay_value_list(Es, Ctxt) ->
+ beside(floating(text("<")),
+ beside(par(seq(Es, floating(text(",")),
+ Ctxt, fun lay/2)),
+ floating(text(">")))).
+
+lay_noann(Node, Ctxt) ->
+ lay(Node, Ctxt#ctxt{noann = true}).
+
+lay_concrete(T, Ctxt) ->
+ lay(abstract(T), Ctxt).
+
+lay_attrdef({K, V}, Ctxt) ->
+ follow(beside(lay_noann(K, Ctxt), floating(text(" ="))),
+ lay_noann(V, Ctxt),
+ Ctxt#ctxt.body_indent).
+
+lay_fdef({N, F}, Ctxt) ->
+ par([beside(lay(N, Ctxt), floating(text(" ="))),
+ lay(F, Ctxt)],
+ Ctxt#ctxt.body_indent).
+
+lay_list_elements(Node, Ctxt) ->
+ T = cons_tl(Node),
+ A = case Ctxt#ctxt.noann of
+ false ->
+ get_ann(T);
+ true ->
+ []
+ end,
+ H = lay(cons_hd(Node), Ctxt),
+ case is_c_cons(T) of
+ true when A =:= [] ->
+ [beside(H, floating(text(",")))
+ | lay_list_elements(T, Ctxt)];
+ _ ->
+ case is_c_nil(T) of
+ true when A =:= [] ->
+ [H];
+ _ ->
+ [H, beside(floating(text("| ")),
+ lay(T, Ctxt))]
+ end
+ end.
+
+seq([H | T], Separator, Ctxt, Fun) ->
+ case T of
+ [] ->
+ [Fun(H, Ctxt)];
+ _ ->
+ [maybe_append(Separator, Fun(H, Ctxt))
+ | seq(T, Separator, Ctxt, Fun)]
+ end;
+seq([], _, _, _) ->
+ [empty()].
+
+maybe_append(none, D) ->
+ D;
+maybe_append(Suffix, D) ->
+ beside(D, Suffix).
+
+vertical([D]) ->
+ D;
+vertical([D | Ds]) ->
+ above(D, vertical(Ds));
+vertical([]) ->
+ [].
+
+% horizontal([D]) ->
+% D;
+% horizontal([D | Ds]) ->
+% beside(D, horizontal(Ds));
+% horizontal([]) ->
+% [].
+
+tidy_float([$., C | Cs]) ->
+ [$., C | tidy_float_1(Cs)]; % preserve first decimal digit
+tidy_float([$e | _] = Cs) ->
+ tidy_float_2(Cs);
+tidy_float([C | Cs]) ->
+ [C | tidy_float(Cs)];
+tidy_float([]) ->
+ [].
+
+tidy_float_1([$0, $0, $0 | Cs]) ->
+ tidy_float_2(Cs); % cut mantissa at three consecutive zeros.
+tidy_float_1([$e | _] = Cs) ->
+ tidy_float_2(Cs);
+tidy_float_1([C | Cs]) ->
+ [C | tidy_float_1(Cs)];
+tidy_float_1([]) ->
+ [].
+
+tidy_float_2([$e, $+, $0]) -> [];
+tidy_float_2([$e, $+, $0 | Cs]) -> tidy_float_2([$e, $+ | Cs]);
+tidy_float_2([$e, $+ | _] = Cs) -> Cs;
+tidy_float_2([$e, $-, $0]) -> [];
+tidy_float_2([$e, $-, $0 | Cs]) -> tidy_float_2([$e, $- | Cs]);
+tidy_float_2([$e, $- | _] = Cs) -> Cs;
+tidy_float_2([$e | Cs]) -> tidy_float_2([$e, $+ | Cs]);
+tidy_float_2([_ | Cs]) -> tidy_float_2(Cs);
+tidy_float_2([]) -> [].
+
+get_line([L | _As]) when is_integer(L) ->
+ L;
+get_line([_ | As]) ->
+ get_line(As);
+get_line([]) ->
+ none.
+
+strip_line([A | As]) when is_integer(A) ->
+ strip_line(As);
+strip_line([A | As]) ->
+ [A | strip_line(As)];
+strip_line([]) ->
+ [].
+
+%% =====================================================================
diff --git a/lib/dialyzer/src/cerl_typean.erl b/lib/dialyzer/src/cerl_typean.erl
new file mode 100644
index 0000000000..3deb4af3e1
--- /dev/null
+++ b/lib/dialyzer/src/cerl_typean.erl
@@ -0,0 +1,994 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 2001-2002 Richard Carlsson
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @doc Type analysis of Core Erlang programs.
+
+%% TODO: filters must handle conjunctions for better precision!
+%% TODO: should get filters from patterns as well as guards.
+%% TODO: unused functions are being included in the analysis.
+
+-module(cerl_typean).
+
+-export([core_transform/2, analyze/1, pp_hook/0]).
+%%-export([analyze/2, analyze/5, annotate/1, annotate/2, annotate/5]).
+
+-import(erl_types, [t_any/0, t_atom/0, t_atom_vals/1, t_binary/0,
+ t_cons/2, t_cons_hd/1, t_cons_tl/1, t_float/0,
+ t_fun/0, t_fun/2, t_from_range/2, t_from_term/1,
+ t_inf/2, t_integer/0,
+ t_is_any/1, t_is_atom/1, t_is_cons/1, t_is_list/1,
+ t_is_maybe_improper_list/1, t_is_none/1, t_is_tuple/1,
+ t_limit/2, t_list_elements/1, t_maybe_improper_list/0,
+ t_none/0, t_number/0, t_pid/0, t_port/0, t_product/1,
+ t_reference/0, t_sup/2, t_to_tlist/1, t_tuple/0, t_tuple/1,
+ t_tuple_args/1, t_tuple_size/1, t_tuple_subtypes/1]).
+
+-import(cerl, [ann_c_fun/3, ann_c_var/2, alias_pat/1, alias_var/1,
+ apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
+ bitstr_val/1, bitstr_type/1, bitstr_flags/1, binary_segments/1,
+ c_letrec/2, c_nil/0,
+ c_values/1, call_args/1, call_module/1, call_name/1,
+ case_arg/1, case_clauses/1, catch_body/1, clause_body/1,
+ clause_guard/1, clause_pats/1, concrete/1, cons_hd/1,
+ cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
+ is_c_atom/1, is_c_int/1, let_arg/1, let_body/1, let_vars/1,
+ letrec_body/1, letrec_defs/1, module_defs/1,
+ module_defs/1, module_exports/1, pat_vars/1,
+ primop_args/1, primop_name/1, receive_action/1,
+ receive_clauses/1, receive_timeout/1, seq_arg/1,
+ seq_body/1, set_ann/2, try_arg/1, try_body/1,
+ try_evars/1, try_handler/1, try_vars/1, tuple_arity/1,
+ tuple_es/1, type/1, values_es/1, var_name/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+-ifdef(DEBUG).
+-define(ANNOTATE(X), case erl_types:t_to_string(X) of Q when length(Q) < 255 -> list_to_atom(Q); Q -> Q end).
+-else.
+-define(ANNOTATE(X), X).
+-endif.
+
+%% Limit for type representation depth.
+-define(DEF_LIMIT, 3).
+
+
+%% @spec core_transform(Module::cerl_records(), Options::[term()]) ->
+%% cerl_records()
+%%
+%% @doc Annotates a module represented by records with type
+%% information. See <code>annotate/1</code> for details.
+%%
+%% <p>Use the compiler option <code>{core_transform, cerl_typean}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see module/2
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(Code, _Opts) ->
+ {Code1, _} = cerl_trees:label(cerl:from_records(Code)),
+ %% io:fwrite("Running type analysis..."),
+ %% {T1,_} = statistics(runtime),
+ {Code2, _, _} = annotate(Code1),
+ %% {T2,_} = statistics(runtime),
+ %% io:fwrite("(~w ms).\n", [T2 - T1]),
+ cerl:to_records(Code2).
+
+
+%% =====================================================================
+%% annotate(Tree) -> {Tree1, Type, Vars}
+%%
+%% Tree = cerl:cerl()
+%%
+%% Analyzes `Tree' (see `analyze') and appends terms `{type, Type}'
+%% to the annotation list of each fun-expression node and
+%% apply-expression node of `Tree', respectively, where `Labels' is
+%% an ordered-set list of labels of fun-expressions in `Tree',
+%% possibly also containing the atom `external', corresponding to
+%% the dependency information derived by the analysis. Any previous
+%% such annotations are removed from `Tree'. `Tree1' is the
+%% modified tree; for details on `OutList', `Outputs' ,
+%% `Dependencies' and `Escapes', see `analyze'.
+%%
+%% Note: `Tree' must be annotated with labels in order to use this
+%% function; see `analyze' for details.
+
+annotate(Tree) ->
+ annotate(Tree, ?DEF_LIMIT).
+
+annotate(Tree, Limit) ->
+ {_, _, Esc, Dep, Par} = cerl_closurean:analyze(Tree),
+ annotate(Tree, Limit, Esc, Dep, Par).
+
+annotate(Tree, Limit, Esc, Dep, Par) ->
+ {Type, Out, Vars} = analyze(Tree, Limit, Esc, Dep, Par),
+ DelAnn = fun (T) -> set_ann(T, delete_ann(type, get_ann(T))) end,
+ SetType = fun (T, Dict) ->
+ case dict:find(get_label(T), Dict) of
+ {ok, X} ->
+ case t_is_any(X) of
+ true ->
+ DelAnn(T);
+ false ->
+ set_ann(T, append_ann(type,
+ ?ANNOTATE(X),
+ get_ann(T)))
+ end;
+ error ->
+ DelAnn(T)
+ end
+ end,
+ F = fun (T) ->
+ case type(T) of
+ var ->
+ SetType(T, Vars);
+ apply ->
+ SetType(T, Out);
+ call ->
+ SetType(T, Out);
+ primop ->
+ SetType(T, Out);
+ 'fun' ->
+ SetType(T, Out);
+ _ ->
+ DelAnn(T)
+ end
+ end,
+ {cerl_trees:map(F, Tree), Type, Vars}.
+
+append_ann(Tag, Val, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ append_ann(Tag, Val, Xs);
+ true ->
+ [X | append_ann(Tag, Val, Xs)]
+ end;
+append_ann(Tag, Val, []) ->
+ [{Tag, Val}].
+
+delete_ann(Tag, [X | Xs]) ->
+ if tuple_size(X) >= 1, element(1, X) =:= Tag ->
+ delete_ann(Tag, Xs);
+ true ->
+ [X | delete_ann(Tag, Xs)]
+ end;
+delete_ann(_, []) ->
+ [].
+
+
+%% =====================================================================
+%% analyze(Tree) -> {OutList, Outputs, Dependencies}
+%%
+%% Tree = cerl:cerl()
+%% OutList = [LabelSet] | none
+%% Outputs = dict(integer(), OutList)
+%% Dependencies = dict(integer(), LabelSet)
+%% LabelSet = ordset(Label)
+%% Label = integer() | external
+%%
+%% Analyzes a module or an expression represented by `Tree'.
+%%
+%% The returned `OutList' is a list of sets of labels of
+%% fun-expressions which correspond to the possible closures in the
+%% value list produced by `Tree' (viewed as an expression; the
+%% "value" of a module contains its exported functions). The atom
+%% `none' denotes missing or conflicting information.
+%%
+%% The atom `external' in any label set denotes any possible
+%% function outside `Tree', including those in `Escapes'.
+%%
+%% `Outputs' is a mapping from the labels of fun-expressions in
+%% `Tree' to corresponding lists of sets of labels of
+%% fun-expressions (or the atom `none'), representing the possible
+%% closures in the value lists returned by the respective
+%% functions.
+%%
+%% `Dependencies' is a similar mapping from the labels of
+%% fun-expressions and apply-expressions in `Tree' to sets of
+%% labels of corresponding fun-expressions which may contain call
+%% sites of the functions or be called from the call sites,
+%% respectively. Any such label not defined in `Dependencies'
+%% represents an unreachable function or a dead or faulty
+%% application.
+%%
+%% `Escapes' is the set of labels of fun-expressions in `Tree' such
+%% that corresponding closures may be accessed from outside `Tree'.
+%%
+%% Note: `Tree' must be annotated with labels (as done by the
+%% function `cerl_trees:label/1') in order to use this function.
+%% The label annotation `{label, L}' (where L should be an integer)
+%% must be the first element of the annotation list of each node in
+%% the tree. Instances of variables bound in `Tree' which denote
+%% the same variable must have the same label; apart from this,
+%% labels should be unique. Constant literals do not need to be
+%% labeled.
+
+-record(state, {k, vars, out, dep, work, funs, envs}).
+
+%% Note: In order to keep our domain simple, we assume that all remote
+%% calls and primops return a single value, if any.
+
+%% We wrap the given syntax tree T in a fun-expression labeled `top',
+%% which is initially in the set of escaped labels. `top' will be
+%% visited at least once.
+%%
+%% We create a separate function labeled `external', defined as:
+%% "External = fun () -> Any", which will represent any and all
+%% functions outside T, and whose return value has unknown type.
+
+-type label() :: integer() | 'external' | 'top'.
+-type ordset(X) :: [X]. % XXX: TAKE ME OUT
+-type labelset() :: ordset(label()).
+-type outlist() :: [labelset()] | 'none'.
+
+-spec analyze(cerl:cerl()) -> {outlist(), dict:dict(), dict:dict()}.
+
+analyze(Tree) ->
+ analyze(Tree, ?DEF_LIMIT).
+
+analyze(Tree, Limit) ->
+ {_, _, Esc, Dep, Par} = cerl_closurean:analyze(Tree),
+ analyze(Tree, Limit, Esc, Dep, Par).
+
+analyze(Tree, Limit, Esc0, Dep0, Par) ->
+ %% Note that we use different name spaces for variable labels and
+ %% function/call site labels. We assume that the labeling of Tree
+ %% only uses integers, not atoms.
+ LabelExtL = [{label, external}],
+ External = ann_c_var(LabelExtL, {external, 1}),
+ ExtFun = ann_c_fun(LabelExtL, [], ann_c_var([{label, any}], 'Any')),
+%%% io:fwrite("external fun:\n~s.\n",
+%%% [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
+ LabelTopL = [{label, top}],
+ Top = ann_c_var(LabelTopL, {top, 0}),
+ TopFun = ann_c_fun(LabelTopL, [], Tree),
+
+ %% The "start fun" just makes the initialisation easier. It is not
+ %% itself in the call graph.
+ StartFun = ann_c_fun([{label, start}], [],
+ c_letrec([{External, ExtFun}, {Top, TopFun}],
+ c_nil())),
+%%% io:fwrite("start fun:\n~s.\n",
+%%% [cerl_prettypr:format(StartFun, [{paper, 80}])]),
+
+ %% Gather a database of all fun-expressions in Tree and initialise
+ %% their outputs and parameter variables. All escaping functions can
+ %% receive any values as inputs. Also add an extra dependency edge
+ %% from each fun-expression label to its parent fun-expression.
+%%% io:fwrite("Escape: ~p.\n",[Esc0]),
+ Esc = sets:from_list(Esc0),
+ Any = t_any(),
+ None = t_none(),
+ Funs0 = dict:new(),
+ Vars0 = dict:store(any, Any, dict:new()),
+ Out0 = dict:store(top, None,
+ dict:store(external, None, dict:new())),
+ Envs0 = dict:store(top, dict:new(),
+ dict:store(external, dict:new(), dict:new())),
+ F = fun (T, S = {Fs, Vs, Os, Es}) ->
+ case type(T) of
+ 'fun' ->
+ L = get_label(T),
+ As = fun_vars(T),
+ X = case sets:is_element(L, Esc) of
+ true -> Any;
+ false -> None
+ end,
+ {dict:store(L, T, Fs),
+ bind_vars_single(As, X, Vs),
+ dict:store(L, None, Os),
+ dict:store(L, dict:new(), Es)};
+ _ ->
+ S
+ end
+ end,
+ {Funs, Vars, Out, Envs} = cerl_trees:fold(F, {Funs0, Vars0, Out0,
+ Envs0}, StartFun),
+
+ %% Add dependencies from funs to their parent funs.
+ Dep = lists:foldl(fun ({L, L1}, D) -> add_dep(L, L1, D) end,
+ Dep0, dict:to_list(Par)),
+
+ %% Enter the fixpoint iteration at the StartFun.
+ St = loop(TopFun, top, #state{vars = Vars,
+ out = Out,
+ dep = Dep,
+ work = init_work(),
+ funs = Funs,
+ envs = Envs,
+ k = Limit}),
+ {dict:fetch(top, St#state.out),
+ tidy_dict([top, external], St#state.out),
+ tidy_dict([any], St#state.vars)}.
+
+tidy_dict([X | Xs], D) ->
+ tidy_dict(Xs, dict:erase(X, D));
+tidy_dict([], D) ->
+ D.
+
+loop(T, L, St0) ->
+%%% io:fwrite("analyzing: ~w.\n",[L]),
+%%% io:fwrite("work: ~w.\n", [Queue0]),
+ Env = dict:fetch(L, St0#state.envs),
+ X0 = dict:fetch(L, St0#state.out),
+ {X1, St1} = visit(fun_body(T), Env, St0),
+ X = limit(X1, St1#state.k),
+ {W, M} = case equal(X0, X) of
+ true ->
+ {St1#state.work, St1#state.out};
+ false ->
+%%% io:fwrite("out (~w) changed: ~s <- ~s.\n",
+%%% [L, erl_types:t_to_string(X),
+%%% erl_types:t_to_string(X0)]),
+ M1 = dict:store(L, X, St1#state.out),
+ case dict:find(L, St1#state.dep) of
+ {ok, S} ->
+%%% io:fwrite("adding work: ~w.\n", [S]),
+ {add_work(S, St1#state.work), M1};
+ error ->
+ {St1#state.work, M1}
+ end
+ end,
+ St2 = St1#state{out = M},
+ case take_work(W) of
+ {ok, L1, W1} ->
+ T1 = dict:fetch(L1, St2#state.funs),
+ loop(T1, L1, St2#state{work = W1});
+ none ->
+ St2
+ end.
+
+visit(T, Env, St) ->
+ case type(T) of
+ literal ->
+ {t_from_term(concrete(T)), St};
+ var ->
+ %% If a variable is not already in the store at this point,
+ %% we initialize it to 'none()'.
+ L = get_label(T),
+ Vars = St#state.vars,
+ case dict:find(L, Vars) of
+ {ok, X} ->
+ case dict:find(var_name(T), Env) of
+ {ok, X1} ->
+%%% io:fwrite("filtered variable reference: ~w:~s.\n",
+%%% [var_name(T), erl_types:t_to_string(X1)]),
+ {meet(X, X1), St};
+ error ->
+ {X, St}
+ end;
+ error ->
+ X = t_none(),
+ Vars1 = dict:store(L, X, Vars),
+ St1 = St#state{vars = Vars1},
+ {X, St1}
+ end;
+ 'fun' ->
+ %% Must revisit the fun also, because its environment might
+ %% have changed. (We don't keep track of such dependencies.)
+ L = get_label(T),
+ Xs = [dict:fetch(get_label(V), St#state.vars)
+ || V <- fun_vars(T)],
+ X = dict:fetch(L, St#state.out),
+ St1 = St#state{work = add_work([L], St#state.work),
+ envs = dict:store(L, Env, St#state.envs)},
+ {t_fun(Xs, X), St1};
+ values ->
+ {Xs, St1} = visit_list(values_es(T), Env, St),
+ {t_product(Xs), St1};
+ cons ->
+ {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], Env, St),
+ {t_cons(X1, X2), St1};
+ tuple ->
+ {Xs, St1} = visit_list(tuple_es(T), Env, St),
+ {t_tuple(Xs), St1};
+ 'let' ->
+ {X, St1} = visit(let_arg(T), Env, St),
+ LetVars = let_vars(T),
+ St1Vars = St1#state.vars,
+ Vars = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ bind_vars_single(LetVars, X, St1Vars);
+ false ->
+ bind_vars(LetVars, t_to_tlist(X), St1Vars)
+ end,
+ visit(let_body(T), Env, St1#state{vars = Vars});
+ seq ->
+ {_, St1} = visit(seq_arg(T), Env, St),
+ visit(seq_body(T), Env, St1);
+ apply ->
+ {_F, St1} = visit(apply_op(T), Env, St),
+ {As, St2} = visit_list(apply_args(T), Env, St1),
+ L = get_label(T),
+ Ls = get_deps(L, St#state.dep),
+ Out = St2#state.out,
+ X = join_list([dict:fetch(L1, Out) || L1 <- Ls]),
+ Out1 = dict:store(L, X, Out),
+ {X, call_site(Ls, As, St2#state{out = Out1})};
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ As = call_args(T),
+ {[X1, X2], St1} = visit_list([M, F], Env, St),
+ {Xs, St2} = visit_list(As, Env, St1),
+%%% io:fwrite("call: ~w:~w(~w).\n",[X1,X2,Xs]),
+ X = case {t_atom_vals(X1), t_atom_vals(X2)} of
+ {[M1], [F1]} ->
+ A = length(As),
+%%% io:fwrite("known call: ~w:~w/~w.\n",
+%%% [M1, F1, A]),
+ call_type(M1, F1, A, Xs);
+ _ ->
+ t_any()
+ end,
+ L = get_label(T),
+ {X, St2#state{out = dict:store(L, X, St2#state.out)}};
+ primop ->
+ As = primop_args(T),
+ {Xs, St1} = visit_list(As, Env, St),
+ F = atom_val(primop_name(T)),
+ A = length(As),
+ L = get_label(T),
+ X = primop_type(F, A, Xs),
+ {X, St1#state{out = dict:store(L, X, St1#state.out)}};
+ 'case' ->
+ {X, St1} = visit(case_arg(T), Env, St),
+ Xs = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ [X || _ <- cerl:case_clauses(T)];
+ false ->
+ t_to_tlist(X)
+ end,
+ join_visit_clauses(Xs, case_clauses(T), Env, St1);
+ 'receive' ->
+ Any = t_any(),
+ {X1, St1} = join_visit_clauses([Any], receive_clauses(T),
+ Env, St),
+ {X2, St2} = visit(receive_timeout(T), Env, St1),
+ case t_is_atom(X2) andalso (t_atom_vals(X2) =:= [infinity]) of
+ true ->
+ {X1, St2};
+ false ->
+ {X3, St3} = visit(receive_action(T), Env, St2),
+ {join(X1, X3), St3}
+ end;
+ 'try' ->
+ {X, St1} = visit(try_arg(T), Env, St),
+ Any = t_any(),
+ Atom = t_atom(),
+ TryVars = try_vars(T),
+ St1Vars = St1#state.vars,
+ Vars = case t_is_any(X) orelse t_is_none(X) of
+ true ->
+ bind_vars_single(TryVars, X, St1Vars);
+ false ->
+ bind_vars(TryVars, t_to_tlist(X), St1Vars)
+ end,
+ {X1, St2} = visit(try_body(T), Env, St1#state{vars = Vars}),
+ EVars = bind_vars(try_evars(T), [Atom, Any, Any], St2#state.vars),
+ {X2, St3} = visit(try_handler(T), Env, St2#state{vars = EVars}),
+ {join(X1, X2), St3};
+ 'catch' ->
+ {_, St1} = visit(catch_body(T), Env, St),
+ {t_any(), St1};
+ binary ->
+ {_, St1} = visit_list(binary_segments(T), Env, St),
+ {t_binary(), St1};
+ bitstr ->
+ %% The other fields are constant literals.
+ {_, St1} = visit(bitstr_val(T), Env, St),
+ {_, St2} = visit(bitstr_size(T), Env, St1),
+ {t_none(), St2};
+ letrec ->
+ %% All the bound funs should be revisited, because the
+ %% environment might have changed.
+ Vars = bind_defs(letrec_defs(T), St#state.vars,
+ St#state.out),
+ Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
+ St1 = St#state{work = add_work(Ls, St#state.work),
+ vars = Vars},
+ visit(letrec_body(T), Env, St1);
+ module ->
+ %% We handle a module as a sequence of function variables in
+ %% the body of a `letrec'.
+ {_, St1} = visit(c_letrec(module_defs(T),
+ c_values(module_exports(T))),
+ Env, St),
+ {t_none(), St1}
+ end.
+
+visit_clause(T, Xs, Env, St) ->
+ Env1 = Env,
+ Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
+ G = clause_guard(T),
+ {_, St1} = visit(G, Env1, St#state{vars = Vars}),
+ Env2 = guard_filters(G, Env1),
+ visit(clause_body(T), Env2, St1).
+
+%% We assume correct value-list typing.
+
+visit_list([T | Ts], Env, St) ->
+ {X, St1} = visit(T, Env, St),
+ {Xs, St2} = visit_list(Ts, Env, St1),
+ {[X | Xs], St2};
+visit_list([], _Env, St) ->
+ {[], St}.
+
+join_visit_clauses(Xs, [T | Ts], Env, St) ->
+ {X1, St1} = visit_clause(T, Xs, Env, St),
+ {X2, St2} = join_visit_clauses(Xs, Ts, Env, St1),
+ {join(X1, X2), St2};
+join_visit_clauses(_, [], _Env, St) ->
+ {t_none(), St}.
+
+bind_defs([{V, F} | Ds], Vars, Out) ->
+ Xs = [dict:fetch(get_label(V1), Vars) || V1 <- fun_vars(F)],
+ X = dict:fetch(get_label(F), Out),
+ bind_defs(Ds, dict:store(get_label(V), t_fun(Xs, X), Vars), Out);
+bind_defs([], Vars, _Out) ->
+ Vars.
+
+bind_pats(Ps, Xs, Vars) ->
+ if length(Xs) =:= length(Ps) ->
+ bind_pats_list(Ps, Xs, Vars);
+ true ->
+ bind_pats_single(Ps, t_none(), Vars)
+ end.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+ Vars1 = bind_pat_vars(P, X, Vars),
+ bind_pats_list(Ps, Xs, Vars1);
+bind_pats_list([], [], Vars) ->
+ Vars.
+
+bind_pats_single([P | Ps], X, Vars) ->
+ bind_pats_single(Ps, X, bind_pat_vars(P, X, Vars));
+bind_pats_single([], _X, Vars) ->
+ Vars.
+
+bind_pat_vars(P, X, Vars) ->
+ case type(P) of
+ var ->
+ dict:store(get_label(P), X, Vars);
+ literal ->
+ Vars;
+ cons ->
+ case t_is_cons(X) of
+ true ->
+ %% If X is "nonempty proper list of X1", then the
+ %% head has type X1 and the tail has type "proper
+ %% list of X1". (If X is just "cons cell of X1",
+ %% then both head and tail have type X1.)
+ Vars1 = bind_pat_vars(cons_hd(P), t_cons_hd(X),
+ Vars),
+ bind_pat_vars(cons_tl(P), t_cons_tl(X), Vars1);
+ false ->
+ case t_is_list(X) of
+ true ->
+ %% If X is "proper list of X1", then the
+ %% head has type X1 and the tail has type
+ %% "proper list of X1", i.e., type X.
+ Vars1 = bind_pat_vars(cons_hd(P),
+ t_list_elements(X),
+ Vars),
+ bind_pat_vars(cons_tl(P), X, Vars1);
+ false ->
+ case t_is_maybe_improper_list(X) of
+ true ->
+ %% If X is "cons cell of X1", both
+ %% the head and tail have type X1.
+ X1 = t_list_elements(X),
+ Vars1 = bind_pat_vars(cons_hd(P),
+ X1, Vars),
+ bind_pat_vars(cons_tl(P), X1,
+ Vars1);
+ false ->
+ bind_vars_single(pat_vars(P),
+ top_or_bottom(X),
+ Vars)
+ end
+ end
+ end;
+ tuple ->
+ case t_is_tuple(X) of
+ true ->
+ case t_tuple_subtypes(X) of
+ unknown ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X),
+ Vars);
+ [Tuple] ->
+ case t_tuple_size(Tuple) =:= tuple_arity(P) of
+ true ->
+ bind_pats_list(tuple_es(P),
+ t_tuple_args(Tuple), Vars);
+
+ false ->
+ bind_vars_single(pat_vars(P),
+ top_or_bottom(X), Vars)
+ end;
+ List when is_list(List) ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X),
+ Vars)
+ end;
+ false ->
+ bind_vars_single(pat_vars(P), top_or_bottom(X), Vars)
+ end;
+ binary ->
+ bind_pats_single(binary_segments(P), t_none(), Vars);
+ bitstr ->
+ %% Only the Value field is a new binding. Size is already
+ %% bound, and the other fields are constant literals.
+ %% We could create a filter for Size being an integer().
+ Size = bitstr_size(P),
+ ValType =
+ case concrete(bitstr_type(P)) of
+ float -> t_float();
+ binary -> t_binary();
+ integer ->
+ case is_c_int(Size) of
+ false -> t_integer();
+ true ->
+ SizeVal = int_val(Size),
+ Flags = concrete(bitstr_flags(P)),
+ case lists:member(signed, Flags) of
+ true ->
+ t_from_range(-(1 bsl (SizeVal - 1)),
+ 1 bsl (SizeVal - 1) - 1);
+ false ->
+ t_from_range(0,1 bsl SizeVal - 1)
+ end
+ end
+ end,
+ bind_pat_vars(bitstr_val(P), ValType, Vars);
+ alias ->
+ P1 = alias_pat(P),
+ Vars1 = bind_pat_vars(P1, X, Vars),
+ dict:store(get_label(alias_var(P)), pat_type(P1, Vars1),
+ Vars1)
+ end.
+
+pat_type(P, Vars) ->
+ case type(P) of
+ var ->
+ dict:fetch(get_label(P), Vars);
+ literal ->
+ t_from_term(concrete(P));
+ cons ->
+ t_cons(pat_type(cons_hd(P), Vars),
+ pat_type(cons_tl(P), Vars));
+ tuple ->
+ t_tuple([pat_type(E, Vars) || E <- tuple_es(P)]);
+ binary ->
+ t_binary();
+ alias ->
+ pat_type(alias_pat(P), Vars)
+ end.
+
+bind_vars(Vs, Xs, Vars) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_vars_list(Vs, Xs, Vars);
+ true ->
+ bind_vars_single(Vs, t_none(), Vars)
+ end.
+
+bind_vars_list([V | Vs], [X | Xs], Vars) ->
+ bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
+bind_vars_list([], [], Vars) ->
+ Vars.
+
+bind_vars_single([V | Vs], X, Vars) ->
+ bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
+bind_vars_single([], _X, Vars) ->
+ Vars.
+
+add_dep(Source, Target, Deps) ->
+ case dict:find(Source, Deps) of
+ {ok, X} ->
+ case set__is_member(Target, X) of
+ true ->
+ Deps;
+ false ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__add(Target, X), Deps)
+ end;
+ error ->
+%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
+ dict:store(Source, set__singleton(Target), Deps)
+ end.
+
+%% This handles a call site, updating parameter variables with respect
+%% to the actual parameters.
+
+call_site(Ls, Xs, St) ->
+%% io:fwrite("call site: ~w ~s.\n",
+%% [Ls, erl_types:t_to_string(erl_types:t_product(Xs))]),
+ {W, V} = call_site(Ls, Xs, St#state.work, St#state.vars,
+ St#state.funs, St#state.k),
+ St#state{work = W, vars = V}.
+
+call_site([L | Ls], Xs, W, V, Fs, Limit) ->
+ Vs = fun_vars(dict:fetch(L, Fs)),
+ case bind_args(Vs, Xs, V, Limit) of
+ {V1, true} ->
+ call_site(Ls, Xs, add_work([L], W), V1, Fs, Limit);
+ {V1, false} ->
+ call_site(Ls, Xs, W, V1, Fs, Limit)
+ end;
+call_site([], _, W, V, _, _) ->
+ {W, V}.
+
+%% If the arity does not match the call, nothing is done here.
+
+bind_args(Vs, Xs, Vars, Limit) ->
+ if length(Vs) =:= length(Xs) ->
+ bind_args(Vs, Xs, Vars, Limit, false);
+ true ->
+ {Vars, false}
+ end.
+
+bind_args([V | Vs], [X | Xs], Vars, Limit, Ch) ->
+ L = get_label(V),
+ {Vars1, Ch1} = bind_arg(L, X, Vars, Limit, Ch),
+ bind_args(Vs, Xs, Vars1, Limit, Ch1);
+bind_args([], [], Vars, _Limit, Ch) ->
+ {Vars, Ch}.
+
+%% bind_arg(L, X, Vars, Limit) ->
+%% bind_arg(L, X, Vars, Limit, false).
+
+bind_arg(L, X, Vars, Limit, Ch) ->
+ X0 = dict:fetch(L, Vars),
+ X1 = limit(join(X, X0), Limit),
+ case equal(X0, X1) of
+ true ->
+ {Vars, Ch};
+ false ->
+%%% io:fwrite("arg (~w) changed: ~s <- ~s + ~s.\n",
+%%% [L, erl_types:t_to_string(X1),
+%%% erl_types:t_to_string(X0),
+%%% erl_types:t_to_string(X)]),
+ {dict:store(L, X1, Vars), true}
+ end.
+
+%% Domain: type(), defined in module `erl_types'.
+
+meet(X, Y) -> t_inf(X, Y).
+
+join(X, Y) -> t_sup(X, Y).
+
+join_list([Xs | Xss]) ->
+ join(Xs, join_list(Xss));
+join_list([]) ->
+ t_none().
+
+equal(X, Y) -> X =:= Y.
+
+limit(X, K) -> t_limit(X, K).
+
+top_or_bottom(T) ->
+ case t_is_none(T) of
+ true ->
+ T;
+ false ->
+ t_any()
+ end.
+
+strict(Xs, T) ->
+ case erl_types:any_none(Xs) of
+ true ->
+ t_none();
+ false ->
+ T
+ end.
+
+%% Set abstraction for label sets.
+
+%% set__new() -> [].
+
+set__singleton(X) -> [X].
+
+%% set__to_list(S) -> S.
+
+%% set__from_list(S) -> ordsets:from_list(S).
+
+%% set__union(X, Y) -> ordsets:union(X, Y).
+
+set__add(X, S) -> ordsets:add_element(X, S).
+
+set__is_member(X, S) -> ordsets:is_element(X, S).
+
+%% set__subtract(X, Y) -> ordsets:subtract(X, Y).
+
+%% set__equal(X, Y) -> X =:= Y.
+
+%% A simple but efficient functional queue.
+
+queue__new() -> {[], []}.
+
+queue__put(X, {In, Out}) -> {[X | In], Out}.
+
+queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
+queue__get({[], _}) -> empty;
+queue__get({In, _}) ->
+ [X | In1] = lists:reverse(In),
+ {ok, X, {[], In1}}.
+
+%% The work list - a queue without repeated elements.
+
+init_work() ->
+ {queue__put(external, queue__new()), sets:new()}.
+
+add_work(Ls, {Q, Set}) ->
+ add_work(Ls, Q, Set).
+
+%% Note that the elements are enqueued in order.
+
+add_work([L | Ls], Q, Set) ->
+ case sets:is_element(L, Set) of
+ true ->
+ add_work(Ls, Q, Set);
+ false ->
+ add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
+ end;
+add_work([], Q, Set) ->
+ {Q, Set}.
+
+take_work({Queue0, Set0}) ->
+ case queue__get(Queue0) of
+ {ok, L, Queue1} ->
+ Set1 = sets:del_element(L, Set0),
+ {ok, L, {Queue1, Set1}};
+ empty ->
+ none
+ end.
+
+get_deps(L, Dep) ->
+ case dict:find(L, Dep) of
+ {ok, Ls} -> Ls;
+ error -> []
+ end.
+
+%% Type information for built-in functions. We do not check that the
+%% arguments have the correct type; if the call would actually fail,
+%% rather than return a value, this is a safe overapproximation.
+
+primop_type(match_fail, 1, _) -> t_none();
+primop_type(_, _, Xs) -> strict(Xs, t_any()).
+
+call_type(M, F, A, Xs) ->
+ erl_bif_types:type(M, F, A, Xs).
+
+guard_filters(T, Env) ->
+ guard_filters(T, Env, dict:new()).
+
+guard_filters(T, Env, Vars) ->
+ case type(T) of
+ call ->
+ M = call_module(T),
+ F = call_name(T),
+ case is_c_atom(M) andalso is_c_atom(F) of
+ true ->
+ As = call_args(T),
+ case {atom_val(M), atom_val(F), length(As)} of
+ {erlang, 'and', 2} ->
+ [A1, A2] = As,
+ guard_filters(A1, guard_filters(A2, Env));
+ {erlang, is_atom, 1} ->
+ filter(As, t_atom(), Env);
+ {erlang, is_binary, 1} ->
+ filter(As, t_binary(), Env);
+ {erlang, is_float, 1} ->
+ filter(As, t_float(), Env);
+ {erlang, is_function, 1} ->
+ filter(As, t_fun(), Env);
+ {erlang, is_integer, 1} ->
+ filter(As, t_integer(), Env);
+ {erlang, is_list, 1} ->
+ filter(As, t_maybe_improper_list(), Env);
+ {erlang, is_number, 1} ->
+ filter(As, t_number(), Env);
+ {erlang, is_pid, 1} ->
+ filter(As, t_pid(), Env);
+ {erlang, is_port, 1} ->
+ filter(As, t_port(), Env);
+ {erlang, is_reference, 1} ->
+ filter(As, t_reference(), Env);
+ {erlang, is_tuple, 1} ->
+ filter(As, t_tuple(), Env);
+ _ ->
+ Env
+ end;
+ false ->
+ Env
+ end;
+ var ->
+ case dict:find(var_name(T), Vars) of
+ {ok, T1} ->
+ guard_filters(T1, Env, Vars);
+ error ->
+ Env
+ end;
+ 'let' ->
+ case let_vars(T) of
+ [V] ->
+ guard_filters(let_body(T), Env,
+ dict:store(var_name(V), let_arg(T),
+ Vars));
+ _ ->
+ Env
+ end;
+ values ->
+ case values_es(T) of
+ [T1] ->
+ guard_filters(T1, Env, Vars);
+ _ ->
+ Env
+ end;
+ _ ->
+ Env
+ end.
+
+filter(As, X, Env) ->
+ [A] = As,
+ case type(A) of
+ var ->
+ V = var_name(A),
+ case dict:find(V, Env) of
+ {ok, X1} ->
+ dict:store(V, meet(X, X1), Env);
+ error ->
+ dict:store(V, X, Env)
+ end;
+ _ ->
+ Env
+ end.
+
+%% Callback hook for cerl_prettypr:
+
+-spec pp_hook() -> fun((cerl:cerl(), _, fun((_,_) -> any())) -> any()).
+
+pp_hook() ->
+ fun pp_hook/3.
+
+pp_hook(Node, Ctxt, Cont) ->
+ As = cerl:get_ann(Node),
+ As1 = proplists:delete(type, proplists:delete(label, As)),
+ As2 = proplists:delete(typesig, proplists:delete(file, As1)),
+ D = Cont(cerl:set_ann(Node, []), Ctxt),
+ T = case proplists:lookup(type, As) of
+ {type, T0} -> T0;
+ none ->
+ case proplists:lookup(typesig, As) of
+ {typesig, T0} -> T0;
+ none -> t_any()
+ end
+ end,
+ D1 = case erl_types:t_is_any(T) of
+ true ->
+ D;
+ false ->
+ case cerl:is_literal(Node) of
+ true ->
+ D;
+ false ->
+ S = erl_types:t_to_string(T),
+ Q = prettypr:beside(prettypr:text("::"),
+ prettypr:text(S)),
+ prettypr:beside(D, Q)
+ end
+ end,
+ cerl_prettypr:annotate(D1, As2, Ctxt).
+
+%% =====================================================================
diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src
index 36f5d96ea6..e22a27dc76 100644
--- a/lib/dialyzer/src/dialyzer.app.src
+++ b/lib/dialyzer/src/dialyzer.app.src
@@ -22,7 +22,12 @@
{application, dialyzer,
[{description, "DIscrepancy AnaLYZer of ERlang programs, version %VSN%"},
{vsn, "%VSN%"},
- {modules, [dialyzer,
+ {modules, [cerl_closurean,
+ cerl_lib,
+ cerl_pmatch,
+ cerl_prettypr,
+ cerl_typean,
+ dialyzer,
dialyzer_analysis_callgraph,
dialyzer_behaviours,
dialyzer_callgraph,
@@ -34,6 +39,7 @@
dialyzer_coordinator,
dialyzer_dataflow,
dialyzer_dep,
+ dialyzer_dot,
dialyzer_explanation,
dialyzer_gui_wx,
dialyzer_options,
@@ -45,10 +51,12 @@
dialyzer_utils,
dialyzer_timing,
dialyzer_worker,
+ erl_bif_types,
+ erl_types,
typer]},
{registered, []},
{applications, [compiler, hipe, kernel, stdlib, wx]},
{env, []},
{runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.4",
- "kernel-5.3","hipe-3.16.1","erts-9.0",
+ "kernel-5.3","erts-9.0",
"compiler-7.0"]}]}.
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index 7411b1d28b..f858a81e63 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -765,7 +765,7 @@ to_dot(#callgraph{digraph = DG, esc = Esc} = CG, File) ->
Escaping = [{Fun(L), {color, red}}
|| L <- [E || {E} <- ets:tab2list(Esc)], L =/= external],
Vertices = digraph_edges(DG),
- hipe_dot:translate_list(Vertices, File, "CG", Escaping).
+ dialyzer_dot:translate_list(Vertices, File, "CG", Escaping).
-spec to_ps(callgraph(), file:filename(), string()) -> 'ok'.
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index f887f661bd..6d06fb2bb4 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -533,7 +533,7 @@ hc(Mod, Cache) ->
%% io:format(" ~w", [Mod]),
case Cache of
false ->
- {ok, Mod} = hipe:c(Mod),
+ {ok, Mod} = dialyzer_whining_inhibitor(hipe, c, [Mod]),
ok;
true ->
hc_cache(Mod)
@@ -547,8 +547,8 @@ hc_cache(Mod) ->
HipeArchVersion =
lists:concat(
[erlang:system_info(hipe_architecture), "-",
- hipe:version(), "-",
- hipe:erts_checksum()]),
+ dialyzer_whining_inhibitor(hipe, version, []), "-",
+ dialyzer_whining_inhibitor(hipe, erts_checksum, [])]),
CacheDir = filename:join(CacheBase, HipeArchVersion),
OrigBeamFile = code:which(Mod),
{ok, {Mod, <<Checksum:128>>}} = beam_lib:md5(OrigBeamFile),
@@ -569,6 +569,15 @@ hc_cache(Mod) ->
true = code:is_module_native(Mod),
ok.
+%% We have an optional runtime dependency on HiPE, but there's no way to
+%% suppress warnings for calls to unknown functions when -Wunknown is on, so
+%% we'll run all HiPE calls through here to suppress warnings when HiPE hasn't
+%% been compiled. :(
+dialyzer_whining_inhibitor(M, F, A) ->
+ apply(id(M), id(F), id(A)).
+
+id(I) -> I.
+
cache_base_dir() ->
%% http://standards.freedesktop.org/basedir-spec/basedir-spec-0.7.html
%% If XDG_CACHE_HOME is set to an absolute path, use it as base.
diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl
index d4d1feeae0..46f631bfd6 100644
--- a/lib/dialyzer/src/dialyzer_dep.erl
+++ b/lib/dialyzer/src/dialyzer_dep.erl
@@ -637,7 +637,7 @@ test(Mod) ->
CallEdges = lists:flatten(CallEdges0),
NamedCallEdges = [{X, dict:fetch(Y, NameMap)} || {X, Y} <- CallEdges],
AllNamedEdges = NamedEdges ++ NamedCallEdges,
- hipe_dot:translate_list(AllNamedEdges, "/tmp/cg.dot", "CG", ColorEsc),
+ dialyzer_dot:translate_list(AllNamedEdges, "/tmp/cg.dot", "CG", ColorEsc),
os:cmd("dot -T ps -o /tmp/cg.ps /tmp/cg.dot"),
ok.
diff --git a/lib/dialyzer/src/dialyzer_dot.erl b/lib/dialyzer/src/dialyzer_dot.erl
new file mode 100644
index 0000000000..210067a2ab
--- /dev/null
+++ b/lib/dialyzer/src/dialyzer_dot.erl
@@ -0,0 +1,212 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%
+%%% Licensed under the Apache License, Version 2.0 (the "License");
+%%% you may not use this file except in compliance with the License.
+%%% You may obtain a copy of the License at
+%%%
+%%% http://www.apache.org/licenses/LICENSE-2.0
+%%%
+%%% Unless required by applicable law or agreed to in writing, software
+%%% distributed under the License is distributed on an "AS IS" BASIS,
+%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%%% See the License for the specific language governing permissions and
+%%% limitations under the License.
+%%%
+%%%-------------------------------------------------------------------
+%%% File : dialyzer_dot.erl
+%%% Author : Per Gustafsson <pergu@it.uu.se>
+%%% Description :
+%%%
+%%% Created : 25 Nov 2004 by Per Gustafsson <pergu@it.uu.se>
+%%%-------------------------------------------------------------------
+
+-module(dialyzer_dot).
+
+-export([translate_digraph/3, translate_digraph/5,
+ translate_list/3, translate_list/4, translate_list/5]).
+
+%%--------------------------------------------------------------------
+
+-type gnode() :: any().
+-type edge() :: {gnode(), gnode()}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% This module creates .dot representations of graphs from their
+%% Erlang representations. There are two different forms of Erlang
+%% representations that the module accepts, digraphs and lists of two
+%% tuples (where each tuple represents a directed edge).
+%%
+%% The functions also require a FileName and a name of the graph. The
+%% filename is the name of the resulting .dot file the GraphName is
+%% pretty much useless.
+%%
+%% The resulting .dot reprsentation will be stored in the flie FileName.
+%%
+%% Interfaces:
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string()) -> ok
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string(), Options::[option] ) -> ok
+%%
+%% translate_list(Graph::[{Node,Node}], FileName::string(),
+%% GraphName::string(), Fun::fun(term() -> string()),
+%% Options::[option]) -> ok
+%%
+%% The optional Fun argument dictates how the node/names should be output.
+%%
+%% The option list can be used to pass options to .dot to decide how
+%% different nodes and edges should be displayed.
+%%
+%% translate_digraph has the same interface as translate_list except
+%% it takes a digraph rather than a list.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec translate_digraph(digraph:graph(), string(), string()) -> 'ok'.
+
+translate_digraph(G, FileName, GName) ->
+ translate_digraph(G, FileName, GName,
+ fun(X) -> io_lib:format("~p", [X]) end, []).
+
+-spec translate_digraph(digraph:graph(), string(), string(),
+ fun((_) -> string()), [_]) -> 'ok'.
+
+translate_digraph(G, FileName, GName, Fun, Opts) ->
+ Edges = [digraph:edge(G, X) || X <- digraph:edges(G)],
+ EdgeList = [{X, Y} || {_, X, Y, _} <- Edges],
+ translate_list(EdgeList, FileName, GName, Fun, Opts).
+
+%%--------------------------------------------------------------------
+
+-spec translate_list([edge()], string(), string()) -> 'ok'.
+
+translate_list(List, FileName, GName) ->
+ translate_list(List, FileName, GName,
+ fun(X) -> lists:flatten(io_lib:format("~p", [X])) end, []).
+
+-spec translate_list([edge()], string(), string(), [_]) -> 'ok'.
+
+translate_list(List, FileName, GName, Opts) ->
+ translate_list(List, FileName, GName,
+ fun(X) -> lists:flatten(io_lib:format("~p", [X])) end, Opts).
+
+-spec translate_list([edge()], string(), string(),
+ fun((_) -> string()), [_]) -> 'ok'.
+
+translate_list(List, FileName, GName, Fun, Opts) ->
+ {NodeList1, NodeList2} = lists:unzip(List),
+ NodeList = NodeList1 ++ NodeList2,
+ NodeSet = ordsets:from_list(NodeList),
+ Start = ["digraph ",GName ," {"],
+ VertexList = [node_format(Opts, Fun, V) ||V <- NodeSet],
+ End = ["graph [", GName, "=", GName, "]}"],
+ EdgeList = [edge_format(Opts, Fun, X, Y) || {X,Y} <- List],
+ String = [Start, VertexList, EdgeList, End],
+ %% io:format("~p~n", [lists:flatten([String])]),
+ ok = file:write_file(FileName, list_to_binary(String)).
+
+%%--------------------------------------------------------------------
+
+node_format(Opt, Fun, V) ->
+ OptText = nodeoptions(Opt, Fun ,V),
+ Tmp = io_lib:format("~p", [Fun(V)]),
+ String = lists:flatten(Tmp),
+ %% io:format("~p", [String]),
+ {Width, Heigth} = calc_dim(String),
+ W = ((Width div 7) + 1) * 0.55,
+ H = Heigth * 0.4,
+ SL = io_lib:format("~f", [W]),
+ SH = io_lib:format("~f", [H]),
+ [String, " [width=", SL, " heigth=", SH, " ", OptText,"];\n"].
+
+edge_format(Opt, Fun, V1, V2) ->
+ OptText =
+ case lists:flatten(edgeoptions(Opt, Fun ,V1, V2)) of
+ [] ->
+ [];
+ [_|X] ->
+ X
+ end,
+ String = [io_lib:format("~p", [Fun(V1)]), " -> ",
+ io_lib:format("~p", [Fun(V2)])],
+ [String, " [", OptText, "];\n"].
+
+calc_dim(String) ->
+ calc_dim(String, 1, 0, 0).
+
+calc_dim("\\n" ++ T, H, TmpW, MaxW) ->
+ calc_dim(T, H+1, 0, erlang:max(TmpW, MaxW));
+calc_dim([_|T], H, TmpW, MaxW) ->
+ calc_dim(T, H, TmpW+1, MaxW);
+calc_dim([], H, TmpW, MaxW) ->
+ {erlang:max(TmpW, MaxW), H}.
+
+edgeoptions([{all_edges, {OptName, OptVal}}|T], Fun, V1, V2) ->
+ case legal_edgeoption(OptName) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|edgeoptions(T, Fun, V1, V2)]
+ %% false ->
+ %% edgeoptions(T, Fun, V1, V2)
+ end;
+edgeoptions([{N1, N2, {OptName, OptVal}}|T], Fun, V1, V2) ->
+ case %% legal_edgeoption(OptName) andalso
+ Fun(N1) =:= Fun(V1) andalso Fun(N2) =:= Fun(V2) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|edgeoptions(T, Fun, V1, V2)];
+ false ->
+ edgeoptions(T, Fun, V1, V2)
+ end;
+edgeoptions([_|T], Fun, V1, V2) ->
+ edgeoptions(T, Fun, V1, V2);
+edgeoptions([], _, _, _) ->
+ [].
+
+nodeoptions([{all_nodes, {OptName, OptVal}}|T], Fun, V) ->
+ case legal_nodeoption(OptName) of
+ true ->
+ [io_lib:format(",~p=~p ", [OptName, OptVal])|nodeoptions(T, Fun, V)];
+ false ->
+ nodeoptions(T, Fun, V)
+ end;
+nodeoptions([{Node, {OptName, OptVal}}|T], Fun, V) ->
+ case Fun(Node) =:= Fun(V) andalso legal_nodeoption(OptName) of
+ true ->
+ [io_lib:format("~p=~p ", [OptName, OptVal])|nodeoptions(T, Fun, V)];
+ false ->
+ nodeoptions(T, Fun, V)
+ end;
+nodeoptions([_|T], Fun, V) ->
+ nodeoptions(T, Fun, V);
+nodeoptions([], _Fun, _V) ->
+ [].
+
+legal_nodeoption(bottomlabel) -> true;
+legal_nodeoption(color) -> true;
+legal_nodeoption(comment) -> true;
+legal_nodeoption(distortion) -> true;
+legal_nodeoption(fillcolor) -> true;
+legal_nodeoption(fixedsize) -> true;
+legal_nodeoption(fontcolor) -> true;
+legal_nodeoption(fontname) -> true;
+legal_nodeoption(fontsize) -> true;
+legal_nodeoption(group) -> true;
+legal_nodeoption(height) -> true;
+legal_nodeoption(label) -> true;
+legal_nodeoption(layer) -> true;
+legal_nodeoption(orientation) -> true;
+legal_nodeoption(peripheries) -> true;
+legal_nodeoption(regular) -> true;
+legal_nodeoption(shape) -> true;
+legal_nodeoption(shapefile) -> true;
+legal_nodeoption(sides) -> true;
+legal_nodeoption(skew) -> true;
+legal_nodeoption(style) -> true;
+legal_nodeoption(toplabel) -> true;
+legal_nodeoption('URL') -> true;
+legal_nodeoption(z) -> true;
+legal_nodeoption(Option) when is_atom(Option) -> false.
+
+legal_edgeoption(Option) when is_atom(Option) -> true.
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index fe85fa81de..ba7404048e 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -520,7 +520,7 @@ compute_new_md5_1([], NewList, Diff) ->
-spec compute_implementation_md5() -> [file_md5()].
compute_implementation_md5() ->
- Dir = code:lib_dir(hipe),
+ Dir = code:lib_dir(dialyzer),
Files1 = ["erl_bif_types.beam", "erl_types.beam"],
Files2 = [filename:join([Dir, "ebin", F]) || F <- Files1],
compute_md5_from_files(Files2).
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index 5f40f80ae7..62ab852fae 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -3511,8 +3511,8 @@ constraints_to_dot(Cs0, Name, State) ->
NofCs = length(Cs0),
Cs = lists:zip(lists:seq(1, NofCs), Cs0),
{Graph, Opts, _N} = constraints_to_nodes(Cs, NofCs + 1, 1, [], [], State),
- hipe_dot:translate_list(Graph, "/tmp/cs.dot", "foo", Opts),
- %% "-T ps" works for Latin-1. hipe_dot cannot handle UTF-8 either.
+ dialyzer_dot:translate_list(Graph, "/tmp/cs.dot", "foo", Opts),
+ %% "-T ps" works for Latin-1. dialyzer_dot cannot handle UTF-8 either.
Res = os:cmd("dot -o /tmp/"++ Name ++ ".ps -T ps /tmp/cs.dot"),
io:format("Res: ~ts~n", [Res]),
ok.
diff --git a/lib/dialyzer/src/erl_bif_types.erl b/lib/dialyzer/src/erl_bif_types.erl
new file mode 100644
index 0000000000..b54e523523
--- /dev/null
+++ b/lib/dialyzer/src/erl_bif_types.erl
@@ -0,0 +1,2896 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @doc Type information for Erlang Built-in functions (implemented in C)
+%% @copyright 2002 Richard Carlsson, 2006 Richard Carlsson, Tobias Lindahl
+%% and Kostis Sagonas
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @author Tobias Lindahl <tobias.lindahl@gmail.com>
+%% @author Kostis Sagonas <kostis@it.uu.se>
+
+-module(erl_bif_types).
+
+%-define(BITS, (hipe_rtl_arch:word_size() * 8) - ?TAG_IMMED1_SIZE).
+-define(BITS, 128). %This is only in bsl to convert answer to pos_inf/neg_inf.
+-export([type/3, type/4, type/5, arg_types/3,
+ is_known/3, opaque_args/5, infinity_add/2]).
+
+-import(erl_types, [number_max/2,
+ number_min/2,
+ t_any/0,
+ t_arity/0,
+ t_atom/0,
+ t_atom/1,
+ t_atoms/1,
+ t_atom_vals/2,
+ t_binary/0,
+ t_bitstr/0,
+ t_boolean/0,
+ t_byte/0,
+ t_cons/0,
+ t_cons/2,
+ t_cons_hd/1,
+ t_cons_tl/1,
+ t_fixnum/0,
+ t_non_neg_fixnum/0,
+ t_pos_fixnum/0,
+ t_float/0,
+ t_from_range/2,
+ t_from_term/1,
+ t_fun/0,
+ t_fun/2,
+ t_fun_args/2,
+ t_fun_range/2,
+ t_identifier/0,
+ t_has_opaque_subtype/2,
+ t_inf/3,
+ t_integer/0,
+ t_integer/1,
+ t_non_neg_fixnum/0,
+ t_non_neg_integer/0,
+ 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_integer/2,
+ t_is_nil/1, t_is_nil/2,
+ t_is_none/1,
+ t_is_none_or_unit/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_subtype/2,
+ t_is_tuple/2,
+ t_list/0,
+ t_list/1,
+ t_list_elements/2,
+ t_list_termination/2,
+ t_mfa/0,
+ t_module/0,
+ t_nil/0,
+ t_node/0,
+ t_none/0,
+ t_nonempty_list/0,
+ t_nonempty_list/1,
+ t_number/0,
+ t_number_vals/2,
+ t_pid/0,
+ t_port/0,
+ t_maybe_improper_list/0,
+ t_reference/0,
+ t_string/0,
+ t_subtract/2,
+ t_sup/1,
+ 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_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
+ ]).
+
+-ifdef(DO_ERL_BIF_TYPES_TEST).
+-export([test/0]).
+-endif.
+
+%%=============================================================================
+
+-spec type(atom(), atom(), arity()) -> erl_types:erl_type().
+
+type(M, F, 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, throw, 1, _, _) -> t_none();
+type(erlang, '==', 2, Xs = [X1, X2], Opaques) ->
+ case
+ t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques)
+ of
+ true -> type(erlang, '=:=', 2, Xs, Opaques);
+ false ->
+ case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of
+ true -> type(erlang, '=:=', 2, Xs, Opaques);
+ false -> strict2(Xs, t_boolean())
+ end
+ end;
+type(erlang, '/=', 2, Xs = [X1, X2], Opaques) ->
+ case
+ t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques)
+ of
+ true -> type(erlang, '=/=', 2, Xs, Opaques);
+ false ->
+ case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of
+ true -> type(erlang, '=/=', 2, Xs, Opaques);
+ false -> strict2(Xs, t_boolean())
+ end
+ end;
+type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_none(t_inf(Lhs, Rhs, Opaques)) of
+ true -> t_atom('false');
+ false ->
+ case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of
+ true ->
+ case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of
+ {unknown, _} -> t_boolean();
+ {_, unknown} -> t_boolean();
+ {[X], [X]} -> t_atom('true');
+ {LhsVals, RhsVals} ->
+ case lists:all(fun({X, Y}) -> X =/= Y end,
+ [{X, Y} || X <- LhsVals, Y <- RhsVals]) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end;
+ false ->
+ case
+ t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques)
+ of
+ false -> t_boolean();
+ true ->
+ case
+ {t_number_vals(Lhs, Opaques), t_number_vals(Rhs, Opaques)}
+ of
+ {[X], [X]} when is_integer(X) -> t_atom('true');
+ _ ->
+ LhsMax = number_max(Lhs, Opaques),
+ LhsMin = number_min(Lhs, Opaques),
+ RhsMax = number_max(Rhs, Opaques),
+ RhsMin = number_min(Rhs, Opaques),
+ Ans1 = (is_integer(LhsMin)
+ andalso is_integer(RhsMax)
+ andalso (LhsMin > RhsMax)),
+ Ans2 = (is_integer(LhsMax)
+ andalso is_integer(RhsMin)
+ andalso (RhsMin > LhsMax)),
+ case Ans1 orelse Ans2 of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end
+ end
+ end
+ end,
+ strict2(Xs, Ans);
+type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_none(t_inf(Lhs, Rhs, Opaques)) of
+ true -> t_atom('true');
+ false ->
+ case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of
+ true ->
+ case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of
+ {unknown, _} -> t_boolean();
+ {_, unknown} -> t_boolean();
+ {[Val], [Val]} -> t_atom('false');
+ {LhsVals, RhsVals} ->
+ t_sup([t_from_term(X =/= Y) || X <- LhsVals, Y <- RhsVals])
+ end;
+ false ->
+ case
+ t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques)
+ 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),
+ Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax)
+ andalso (LhsMin > RhsMax)),
+ Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin)
+ andalso (RhsMin > LhsMax)),
+ case Ans1 orelse Ans2 of
+ true -> t_atom('true');
+ false ->
+ if LhsMax =:= LhsMin,
+ RhsMin =:= RhsMax,
+ RhsMax =:= LhsMax -> t_atom('false');
+ true -> t_boolean()
+ end
+ end
+ end
+ end
+ end,
+ strict2(Xs, Ans);
+type(erlang, '>', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of
+ true ->
+ LhsMax = number_max(Lhs, Opaques),
+ LhsMin = number_min(Lhs, Opaques),
+ RhsMax = number_max(Rhs, Opaques),
+ RhsMin = number_min(Rhs, Opaques),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMin), is_integer(RhsMax), LhsMin > RhsMax -> T;
+ is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F;
+ true -> t_boolean()
+ end;
+ false -> compare('>', Lhs, Rhs, Opaques)
+ end,
+ strict2(Xs, Ans);
+type(erlang, '>=', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of
+ true ->
+ LhsMax = number_max(Lhs, Opaques),
+ LhsMin = number_min(Lhs, Opaques),
+ RhsMax = number_max(Rhs, Opaques),
+ RhsMin = number_min(Rhs, Opaques),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMin), is_integer(RhsMax), LhsMin >= RhsMax -> T;
+ is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F;
+ true -> t_boolean()
+ end;
+ false -> compare('>=', Lhs, Rhs, Opaques)
+ end,
+ strict2(Xs, Ans);
+type(erlang, '<', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of
+ true ->
+ LhsMax = number_max(Lhs, Opaques),
+ LhsMin = number_min(Lhs, Opaques),
+ RhsMax = number_max(Rhs, Opaques),
+ RhsMin = number_min(Rhs, Opaques),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMax), is_integer(RhsMin), LhsMax < RhsMin -> T;
+ is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F;
+ true -> t_boolean()
+ end;
+ false -> compare('<', Lhs, Rhs, Opaques)
+ end,
+ strict2(Xs, Ans);
+type(erlang, '=<', 2, Xs = [Lhs, Rhs], Opaques) ->
+ Ans =
+ case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of
+ true ->
+ LhsMax = number_max(Lhs, Opaques),
+ LhsMin = number_min(Lhs, Opaques),
+ RhsMax = number_max(Rhs, Opaques),
+ RhsMin = number_min(Rhs, Opaques),
+ T = t_atom('true'),
+ F = t_atom('false'),
+ if
+ is_integer(LhsMax), is_integer(RhsMin), LhsMax =< RhsMin -> T;
+ is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F;
+ true -> t_boolean()
+ end;
+ false -> compare('=<', Lhs, Rhs, Opaques)
+ end,
+ strict2(Xs, Ans);
+type(erlang, '+', 1, Xs, Opaques) ->
+ strict(erlang, '+', 1, Xs, fun ([X]) -> X end, Opaques);
+type(erlang, '-', 1, Xs, Opaques) ->
+ strict(erlang, '-', 1, Xs,
+ fun ([X]) ->
+ case t_is_integer(X, Opaques) 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) ->
+ strict(erlang, '+', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('+', X1, X2, Opaques) of
+ {ok, T} -> T;
+ error ->
+ case
+ t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques)
+ of
+ true -> t_float();
+ false -> t_number()
+ end
+ end
+ end, Opaques);
+type(erlang, '-', 2, Xs, Opaques) ->
+ strict(erlang, '-', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('-', X1, X2, Opaques) of
+ {ok, T} -> T;
+ error ->
+ case
+ t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques)
+ of
+ true -> t_float();
+ false -> t_number()
+ end
+ end
+ end, Opaques);
+type(erlang, '*', 2, Xs, Opaques) ->
+ strict(erlang, '*', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('*', X1, X2, Opaques) of
+ {ok, T} -> T;
+ error ->
+ case
+ t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques)
+ 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) ->
+ strict(erlang, 'div', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('div', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+type(erlang, 'rem', 2, Xs, Opaques) ->
+ strict(erlang, 'rem', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('rem', X1, X2, Opaques) of
+ error -> t_non_neg_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+type(erlang, '++', 2, Xs, Opaques) ->
+ strict(erlang, '++', 2, Xs,
+ fun ([X1, X2]) ->
+ case t_is_nil(X1, Opaques) of
+ true -> X2; % even if X2 is not a list
+ false ->
+ case t_is_nil(X2, Opaques) of
+ true -> X1;
+ false ->
+ E1 = t_list_elements(X1, Opaques),
+ case t_is_cons(X1, Opaques) of
+ true -> t_cons(E1, X2);
+ false ->
+ t_sup(X2, t_cons(E1, X2))
+ end
+ end
+ end
+ end, Opaques);
+type(erlang, '--', 2, Xs, Opaques) ->
+ %% We don't know which elements (if any) in X2 will be found and
+ %% removed from X1, even if they would have the same type. Thus, we
+ %% must assume that X1 can remain unchanged. However, if we succeed,
+ %% we know that X1 must be a proper list, but the result could
+ %% possibly be empty even if X1 is nonempty.
+ strict(erlang, '--', 2, Xs,
+ fun ([X1, X2]) ->
+ case t_is_nil(X1, Opaques) of
+ true -> t_nil();
+ false ->
+ case t_is_nil(X2, Opaques) of
+ true -> X1;
+ false -> t_list(t_list_elements(X1, Opaques))
+ 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) ->
+ strict(erlang, 'band', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('band', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% 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) ->
+ strict(erlang, 'bor', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('bor', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% 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) ->
+ strict(erlang, 'bxor', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('bxor', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% 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) ->
+ strict(erlang, 'bsr', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('bsr', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% If the first argument is unsigned (which is the case for
+%% characters and bytes), the result is never wider. We need to kill
+%% any value-sets in the result.
+%% strict(erlang, 'bsr', 2, Xs,
+%% fun ([X, _]) -> t_sup(X, t_byte()) end, Opaques);
+type(erlang, 'bsl', 2, Xs, Opaques) ->
+ strict(erlang, 'bsl', 2, Xs,
+ fun ([X1, X2]) ->
+ case arith('bsl', X1, X2, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% Not worth doing anything special here.
+%% strict(erlang, 'bsl', 2, Xs, fun (_) -> t_integer() end, Opaques);
+type(erlang, 'bnot', 1, Xs, Opaques) ->
+ strict(erlang, 'bnot', 1, Xs,
+ fun ([X1]) ->
+ case arith_bnot(X1, Opaques) of
+ error -> t_integer();
+ {ok, T} -> T
+ end
+ end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, abs, 1, Xs, Opaques) ->
+ strict(erlang, abs, 1, Xs,
+ fun ([X1]) -> arith_abs(X1, Opaques) end, Opaques);
+%% 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) ->
+ Fun = fun ([X, _Y]) ->
+ case t_is_fun(X, Opaques) of
+ true ->
+ t_fun_range(X, Opaques);
+ 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);
+%% Guard bif, needs to be here.
+type(erlang, binary_part, 2, Xs, Opaques) ->
+ strict(erlang, binary_part, 2, Xs, fun (_) -> t_binary() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, binary_part, 3, Xs, Opaques) ->
+ strict(erlang, binary_part, 3, Xs, fun (_) -> t_binary() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, bit_size, 1, Xs, Opaques) ->
+ strict(erlang, bit_size, 1, Xs,
+ fun (_) -> t_non_neg_integer() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, byte_size, 1, Xs, Opaques) ->
+ strict(erlang, byte_size, 1, Xs,
+ fun (_) -> t_non_neg_integer() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, ceil, 1, Xs, Opaques) ->
+ strict(erlang, ceil, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Guard bif, needs to be here.
+%% Also much more expressive than anything you could write in a spec...
+type(erlang, element, 2, Xs, Opaques) ->
+ strict(erlang, element, 2, Xs,
+ fun ([X1, X2]) ->
+ case t_tuple_subtypes(X2, Opaques) of
+ unknown -> t_any();
+ [_] ->
+ Sz = t_tuple_size(X2, Opaques),
+ As = t_tuple_args(X2, Opaques),
+ case t_number_vals(X1, Opaques) of
+ unknown -> t_sup(As);
+ Ns when is_list(Ns) ->
+ Fun = fun
+ (N, X) when is_integer(N), 1 =< N, N =< Sz ->
+ t_sup(X, lists:nth(N, As));
+ (_, X) ->
+ X
+ end,
+ lists:foldl(Fun, t_none(), Ns)
+ end;
+ Ts when is_list(Ts) ->
+ t_sup([type(erlang, element, 2, [X1, Y]) || Y <- Ts])
+ end
+ end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, float, 1, Xs, Opaques) ->
+ strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, floor, 1, Xs, Opaques) ->
+ strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Primop, needs to be somewhere.
+type(erlang, build_stacktrace, 0, _, _Opaques) ->
+ t_list(t_tuple([t_module(),
+ t_atom(),
+ t_sup([t_arity(),t_list()]),
+ t_list(t_sup([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
+%% 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) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_atom(Y, Opaques) end,
+ t_atom(), Opaques)
+ end,
+ strict(erlang, is_atom, 1, Xs, Fun, Opaques);
+type(erlang, is_binary, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_binary(Y, Opaques) end,
+ t_binary(), Opaques)
+ end,
+ strict(erlang, is_binary, 1, Xs, Fun, Opaques);
+type(erlang, is_bitstring, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_bitstr(Y, Opaques) end,
+ t_bitstr(), Opaques)
+ end,
+ strict(erlang, is_bitstring, 1, Xs, Fun, Opaques);
+type(erlang, is_boolean, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_boolean(Y, Opaques) end,
+ t_boolean(), Opaques)
+ end,
+ strict(erlang, is_boolean, 1, Xs, Fun, Opaques);
+type(erlang, is_float, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_float(Y, Opaques) end,
+ t_float(), Opaques)
+ end,
+ strict(erlang, is_float, 1, Xs, Fun, Opaques);
+type(erlang, is_function, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_fun(Y, Opaques) end,
+ t_fun(), Opaques)
+ end,
+ strict(erlang, is_function, 1, Xs, Fun, Opaques);
+type(erlang, is_function, 2, Xs, Opaques) ->
+ Fun = fun ([FunType, ArityType]) ->
+ case t_number_vals(ArityType, Opaques) of
+ unknown -> t_boolean();
+ [Val] ->
+ FunConstr = t_fun(any_list(Val), t_any()),
+ Fun2 = fun (X) ->
+ t_is_subtype(X, FunConstr) andalso (not t_is_none(X))
+ end,
+ check_guard_single(FunType, Fun2, FunConstr, Opaques);
+ 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) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_integer(Y, Opaques) end,
+ t_integer(), Opaques)
+ end,
+ strict(erlang, is_integer, 1, Xs, Fun, Opaques);
+type(erlang, is_list, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ Fun2 = fun (Y) -> t_is_maybe_improper_list(Y, Opaques) end,
+ check_guard(X, Fun2, t_maybe_improper_list(), Opaques)
+ end,
+ strict(erlang, is_list, 1, Xs, Fun, Opaques);
+type(erlang, is_map, 1, Xs, Opaques) ->
+ 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) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end,
+ t_number(), Opaques)
+ end,
+ strict(erlang, is_number, 1, Xs, Fun, Opaques);
+type(erlang, is_pid, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_pid(Y, Opaques) end,
+ t_pid(), Opaques)
+ end,
+ strict(erlang, is_pid, 1, Xs, Fun, Opaques);
+type(erlang, is_port, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_port(Y, Opaques) end,
+ t_port(), Opaques)
+ end,
+ strict(erlang, is_port, 1, Xs, Fun, Opaques);
+type(erlang, is_record, 2, Xs, Opaques) ->
+ Fun = fun ([X, Y]) ->
+ case t_is_tuple(X, Opaques) 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;
+ false -> t_boolean()
+ end;
+ true ->
+ case t_tuple_subtypes(X, Opaques) of
+ unknown -> t_boolean();
+ [Tuple] ->
+ case t_tuple_args(Tuple, Opaques) of
+ %% any -> t_boolean();
+ [Tag|_] -> check_record_tag(Tag, Y, Opaques)
+ end;
+ List when length(List) >= 2 ->
+ t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List])
+ end
+ end
+ end,
+ strict(erlang, is_record, 2, Xs, Fun, Opaques);
+type(erlang, is_record, 3, Xs, Opaques) ->
+ Fun = fun ([X, Y, Z]) ->
+ Arity = t_number_vals(Z, Opaques),
+ case t_is_tuple(X, Opaques) of
+ false when length(Arity) =:= 1 ->
+ [RealArity] = Arity,
+ case t_is_none(t_inf(t_tuple(RealArity), X, Opaques)) of
+ true ->
+ case t_has_opaque_subtype(X, Opaques) of
+ true -> t_none();
+ false -> t_atom('false')
+ end;
+ false -> t_boolean()
+ end;
+ false ->
+ case t_is_none(t_inf(t_tuple(), X, Opaques)) of
+ true ->
+ case t_has_opaque_subtype(X, Opaques) of
+ true -> t_none();
+ false -> t_atom('false')
+ end;
+ false -> t_boolean()
+ end;
+ true when length(Arity) =:= 1 ->
+ [RealArity] = Arity,
+ case t_tuple_subtypes(X, Opaques) of
+ unknown -> t_boolean();
+ [Tuple] ->
+ case t_tuple_args(Tuple, Opaques) of
+ %% any -> t_boolean();
+ Args when length(Args) =:= RealArity ->
+ check_record_tag(hd(Args), Y, Opaques);
+ Args when length(Args) =/= RealArity ->
+ t_atom('false')
+ end;
+ [_, _|_] ->
+ t_boolean()
+ end;
+ true ->
+ t_boolean()
+ end
+ end,
+ strict(erlang, is_record, 3, Xs, Fun, Opaques);
+type(erlang, is_reference, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_reference(Y, Opaques) end,
+ t_reference(), Opaques)
+ end,
+ strict(erlang, is_reference, 1, Xs, Fun, Opaques);
+type(erlang, is_tuple, 1, Xs, Opaques) ->
+ Fun = fun (X) ->
+ check_guard(X, fun (Y) -> t_is_tuple(Y, Opaques) end,
+ t_tuple(), Opaques)
+ end,
+ strict(erlang, is_tuple, 1, Xs, Fun, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, length, 1, Xs, Opaques) ->
+ strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, map_size, 1, Xs, Opaques) ->
+ type(maps, size, 1, Xs, Opaques);
+%% 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) ->
+ strict(erlang, make_fun, 3, Xs,
+ fun ([_, _, Arity]) ->
+ case t_number_vals(Arity, Opaques) of
+ [N] ->
+ case is_integer(N) andalso 0 =< N andalso N =< 255 of
+ true -> t_fun(N, t_any());
+ false -> t_none()
+ end;
+ _Other -> t_fun()
+ end
+ end, Opaques);
+type(erlang, make_tuple, 2, Xs, Opaques) ->
+ strict(erlang, make_tuple, 2, Xs,
+ fun ([Int, _]) ->
+ case t_number_vals(Int, Opaques) of
+ [N] when is_integer(N), N >= 0 -> t_tuple(N);
+ _Other -> t_tuple()
+ end
+ end, Opaques);
+type(erlang, make_tuple, 3, Xs, Opaques) ->
+ strict(erlang, make_tuple, 3, Xs,
+ fun ([Int, _, _]) ->
+ case t_number_vals(Int, Opaques) of
+ [N] when is_integer(N), N >= 0 -> t_tuple(N);
+ _Other -> t_tuple()
+ end
+ end, Opaques);
+type(erlang, nif_error, 1, Xs, Opaques) ->
+ %% this BIF and the next one are stubs for NIFs and never return
+ strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques);
+type(erlang, nif_error, 2, Xs, Opaques) ->
+ strict(erlang, nif_error, 2, Xs, fun (_) -> t_any() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, node, 0, _, _Opaques) -> t_node();
+%% Guard bif, needs to be here.
+type(erlang, node, 1, Xs, Opaques) ->
+ strict(erlang, node, 1, Xs, fun (_) -> t_node() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, round, 1, Xs, Opaques) ->
+ strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, self, 0, _, _Opaques) -> t_pid();
+type(erlang, setelement, 3, Xs, Opaques) ->
+ strict(erlang, setelement, 3, Xs,
+ fun ([X1, X2, X3]) ->
+ case t_tuple_subtypes(X2, Opaques) of
+ unknown -> t_tuple();
+ [_] ->
+ Sz = t_tuple_size(X2, Opaques),
+ As = t_tuple_args(X2, Opaques),
+ case t_number_vals(X1, Opaques) of
+ unknown ->
+ t_tuple([t_sup(X, X3) || X <- As]);
+ [N] when is_integer(N), 1 =< N, N =< Sz ->
+ t_tuple(list_replace(N, X3, As));
+ [N] when is_integer(N), N < 1 ->
+ t_none();
+ [N] when is_integer(N), N > Sz ->
+ t_none();
+ Ns ->
+ Fun = fun (N, XL) when is_integer(N), 1 =< N, N =< Sz ->
+ X = lists:nth(N, XL),
+ Y = t_sup(X, X3),
+ list_replace(N, Y, XL);
+ (_, XL) ->
+ XL
+ end,
+ t_tuple(lists:foldl(Fun, As, Ns))
+ end;
+ Ts when is_list(Ts) ->
+ t_sup([type(erlang, setelement, 3, [X1, Y, X3]) || Y <- Ts])
+ end
+ end, Opaques);
+%% 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) ->
+ strict(erlang, system_info, 1, Xs,
+ fun ([Type]) ->
+ case t_is_atom(Type, Opaques) of
+ true ->
+ case t_atom_vals(Type, Opaques) of
+ ['allocated_areas'] ->
+ t_list(t_sup([t_tuple([t_atom(),t_non_neg_integer()]),
+ t_tuple([t_atom(),
+ t_non_neg_integer(),
+ t_non_neg_integer()])]));
+ ['allocator'] ->
+ t_tuple([t_sup([t_atom('undefined'),
+ t_atom('glibc')]),
+ t_list(t_integer()),
+ t_list(t_atom()),
+ t_list(t_tuple([t_atom(),
+ t_list(t_tuple([t_atom(),
+ t_any()]))]))]);
+ ['break_ignored'] ->
+ t_boolean();
+ ['cpu_topology'] ->
+ t_system_cpu_topology();
+ ['compat_rel'] ->
+ t_non_neg_fixnum();
+ ['creation'] ->
+ t_fixnum();
+ ['debug_compiled'] ->
+ t_boolean();
+ ['dist'] ->
+ t_binary();
+ ['dist_ctrl'] ->
+ t_list(t_tuple([t_atom(), t_sup([t_pid(), t_port()])]));
+ ['endian'] ->
+ t_endian();
+ ['fullsweep_after'] ->
+ t_tuple([t_atom('fullsweep_after'), t_non_neg_integer()]);
+ ['garbage_collection'] ->
+ t_list();
+ ['heap_sizes'] ->
+ t_list(t_integer());
+ ['heap_type'] ->
+ t_atom('private');
+ ['hipe_architecture'] ->
+ t_atoms(['amd64', 'arm', 'powerpc', 'ppc64',
+ 'undefined', 'ultrasparc', 'x86']);
+ ['info'] ->
+ t_binary();
+ ['internal_cpu_topology'] -> %% Undocumented internal feature
+ t_internal_cpu_topology();
+ ['loaded'] ->
+ t_binary();
+ ['logical_processors'] ->
+ t_non_neg_fixnum();
+ ['machine'] ->
+ t_string();
+ ['multi_scheduling'] ->
+ t_system_multi_scheduling();
+ ['multi_scheduling_blockers'] ->
+ t_list(t_pid());
+ ['os_type'] ->
+ t_tuple([t_sup([t_atom('unix'),
+ t_atom('win32')]),
+ t_atom()]);
+ ['os_version'] ->
+ t_sup(t_tuple([t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum()]),
+ t_string());
+ ['otp_release'] ->
+ t_string();
+ ['port_parallelism'] ->
+ t_boolean();
+ ['port_count'] ->
+ t_non_neg_fixnum();
+ ['port_limit'] ->
+ t_non_neg_fixnum();
+ ['process_count'] ->
+ t_non_neg_fixnum();
+ ['process_limit'] ->
+ t_non_neg_fixnum();
+ ['procs'] ->
+ t_binary();
+ ['scheduler_bindings'] ->
+ t_tuple();
+ ['scheduler_bind_type'] ->
+ t_scheduler_bind_type_results();
+ ['schedulers'] ->
+ t_pos_fixnum();
+ ['schedulers_online'] ->
+ t_pos_fixnum();
+ ['sequential_tracer'] ->
+ t_tuple([t_atom('sequential_tracer'),
+ t_sequential_tracer()]);
+ ['smp_support'] ->
+ t_boolean();
+ ['system_architecture'] ->
+ t_string();
+ ['system_version'] ->
+ t_string();
+ ['threads'] ->
+ t_boolean();
+ ['thread_pool_size'] ->
+ t_non_neg_fixnum();
+ ['trace_control_word'] ->
+ t_integer();
+ ['version'] ->
+ t_string();
+ ['wordsize'] ->
+ t_integers([4,8]);
+ List when is_list(List) ->
+ t_any(); %% gross overapproximation
+ unknown ->
+ t_any()
+ end;
+ false -> %% This currently handles only {allocator, Alloc}
+ t_any() %% overapproximation as the return value might change
+ end
+ end, Opaques);
+%% 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);
+%% Guard bif, needs to be here.
+type(erlang, trunc, 1, Xs, Opaques) ->
+ strict(erlang, trunc, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, tuple_size, 1, Xs, Opaques) ->
+ strict(erlang, tuple_size, 1, Xs,
+ fun (_) -> t_non_neg_integer() end, Opaques);
+type(erlang, tuple_to_list, 1, Xs, Opaques) ->
+ strict(erlang, tuple_to_list, 1, Xs,
+ fun ([X]) ->
+ case t_tuple_subtypes(X, Opaques) of
+ unknown -> t_list();
+ SubTypes ->
+ Args = lists:append([t_tuple_args(ST, Opaques) ||
+ ST <- SubTypes]),
+ %% Can be nil if the tuple can be {}
+ case lists:any(fun (T) ->
+ t_tuple_size(T, Opaques) =:= 0
+ end, SubTypes) of
+ true ->
+ %% Be careful here. If we had only {} we need to
+ %% keep the nil.
+ t_sup(t_nonempty_list(t_sup(Args)), t_nil());
+ false ->
+ t_nonempty_list(t_sup(Args))
+ end
+ end
+ end, Opaques);
+%%-- hipe_bifs ----------------------------------------------------------------
+type(hipe_bifs, add_ref, 2, Xs, Opaques) ->
+ strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_atom('ok') end, Opaques);
+type(hipe_bifs, alloc_data, 3, Xs, Opaques) ->
+ strict(hipe_bifs, alloc_data, 3, Xs,
+ fun (_) -> t_integer() end, Opaques); % address
+type(hipe_bifs, array, 2, Xs, Opaques) ->
+ strict(hipe_bifs, array, 2, Xs, fun (_) -> t_immarray() end, Opaques);
+type(hipe_bifs, array_length, 1, Xs, Opaques) ->
+ strict(hipe_bifs, array_length, 1, Xs,
+ fun (_) -> t_non_neg_fixnum() end, Opaques);
+type(hipe_bifs, array_sub, 2, Xs, Opaques) ->
+ strict(hipe_bifs, array_sub, 2, Xs, fun (_) -> t_immediate() end, Opaques);
+type(hipe_bifs, array_update, 3, Xs, Opaques) ->
+ strict(hipe_bifs, array_update, 3, Xs,
+ fun (_) -> t_immarray() end, Opaques);
+type(hipe_bifs, atom_to_word, 1, Xs, Opaques) ->
+ strict(hipe_bifs, atom_to_word, 1, Xs,
+ fun (_) -> t_integer() end, Opaques);
+type(hipe_bifs, bif_address, 3, Xs, Opaques) ->
+ strict(hipe_bifs, bif_address, 3, Xs,
+ fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques);
+type(hipe_bifs, bitarray, 2, Xs, Opaques) ->
+ strict(hipe_bifs, bitarray, 2, Xs, fun (_) -> t_bitarray() end, Opaques);
+type(hipe_bifs, bitarray_sub, 2, Xs, Opaques) ->
+ strict(hipe_bifs, bitarray_sub, 2, Xs,
+ fun (_) -> t_boolean() end, Opaques);
+type(hipe_bifs, bitarray_update, 3, Xs, Opaques) ->
+ strict(hipe_bifs, bitarray_update, 3, Xs,
+ fun (_) -> t_bitarray() end, Opaques);
+type(hipe_bifs, bytearray, 2, Xs, Opaques) ->
+ strict(hipe_bifs, bytearray, 2, Xs, fun (_) -> t_bytearray() end, Opaques);
+type(hipe_bifs, bytearray_sub, 2, Xs, Opaques) ->
+ strict(hipe_bifs, bytearray_sub, 2, Xs, fun (_) -> t_byte() end, Opaques);
+type(hipe_bifs, bytearray_update, 3, Xs, Opaques) ->
+ strict(hipe_bifs, bytearray_update, 3, Xs,
+ fun (_) -> t_bytearray() end, Opaques);
+type(hipe_bifs, call_count_clear, 1, Xs, Opaques) ->
+ strict(hipe_bifs, call_count_clear, 1, Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques);
+type(hipe_bifs, call_count_get, 1, Xs, Opaques) ->
+ strict(hipe_bifs, call_count_get, 1, Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques);
+type(hipe_bifs, call_count_off, 1, Xs, Opaques) ->
+ strict(hipe_bifs, call_count_off, 1, Xs,
+ fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques);
+type(hipe_bifs, call_count_on, 1, Xs, Opaques) ->
+ strict(hipe_bifs, call_count_on, 1, Xs,
+ fun (_) -> t_sup(t_atom('true'), t_nil()) end, Opaques);
+type(hipe_bifs, check_crc, 1, Xs, Opaques) ->
+ strict(hipe_bifs, check_crc, 1, Xs, fun (_) -> t_boolean() end, Opaques);
+type(hipe_bifs, enter_code, 3, Xs, Opaques) ->
+ strict(hipe_bifs, enter_code, 3, Xs,
+ fun (_) -> t_tuple([t_integer(),
+ %% XXX: The tuple below contains integers and
+ %% is of size same as the length of the MFA list
+ t_sup(t_nil(), t_binary())]) end, Opaques);
+type(hipe_bifs, enter_sdesc, 2, Xs, Opaques) ->
+ strict(hipe_bifs, enter_sdesc, 2, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, find_na_or_make_stub, 1, Xs, Opaques) ->
+ strict(hipe_bifs, find_na_or_make_stub, 1, Xs,
+ fun (_) -> t_integer() end, Opaques); % address
+type(hipe_bifs, fun_to_address, 1, Xs, Opaques) ->
+ strict(hipe_bifs, fun_to_address, 1, Xs,
+ fun (_) -> t_integer() end, Opaques);
+type(hipe_bifs, get_fe, 2, Xs, Opaques) ->
+ strict(hipe_bifs, get_fe, 2, Xs, fun (_) -> t_integer() end, Opaques);
+type(hipe_bifs, get_rts_param, 1, Xs, Opaques) ->
+ strict(hipe_bifs, get_rts_param, 1, Xs,
+ fun (_) -> t_sup(t_integer(), t_nil()) end, Opaques);
+type(hipe_bifs, merge_term, 1, Xs, Opaques) ->
+ strict(hipe_bifs, merge_term, 1, Xs, fun ([X]) -> X end, Opaques);
+type(hipe_bifs, nstack_used_size, 0, _, _Opaques) ->
+ t_non_neg_fixnum();
+type(hipe_bifs, patch_call, 3, Xs, Opaques) ->
+ strict(hipe_bifs, patch_call, 3, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, patch_insn, 3, Xs, Opaques) ->
+ strict(hipe_bifs, patch_insn, 3, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, primop_address, 1, Xs, Opaques) ->
+ strict(hipe_bifs, primop_address, 1, Xs,
+ fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques);
+type(hipe_bifs, ref, 1, Xs, Opaques) ->
+ strict(hipe_bifs, ref, 1, Xs, fun (_) -> t_immarray() end, Opaques);
+type(hipe_bifs, ref_get, 1, Xs, Opaques) ->
+ strict(hipe_bifs, ref_get, 1, Xs, fun (_) -> t_immediate() end, Opaques);
+type(hipe_bifs, ref_set, 2, Xs, Opaques) ->
+ strict(hipe_bifs, ref_set, 2, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, set_funinfo_native_address, 3, Xs, Opaques) ->
+ strict(hipe_bifs, set_funinfo_native_address, 3, Xs,
+ fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, commit_patch_load, 1, Xs, Opaques) ->
+ strict(hipe_bifs, commit_patch_load, 1, Xs,
+ fun (_) -> t_atom() end, Opaques);
+type(hipe_bifs, set_native_address, 3, Xs, Opaques) ->
+ strict(hipe_bifs, set_native_address, 3, Xs,
+ fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) ->
+ strict(hipe_bifs, set_native_address_in_fe, 2, Xs,
+ fun (_) -> t_atom('true') end, Opaques);
+type(hipe_bifs, system_crc, 0, _, _Opaques) ->
+ t_crc32();
+type(hipe_bifs, term_to_word, 1, Xs, Opaques) ->
+ strict(hipe_bifs, term_to_word, 1, Xs,
+ fun (_) -> t_integer() end, Opaques);
+type(hipe_bifs, write_u8, 2, Xs, Opaques) ->
+ strict(hipe_bifs, write_u8, 2, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, write_u32, 2, Xs, Opaques) ->
+ strict(hipe_bifs, write_u32, 2, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, write_u64, 2, Xs, Opaques) ->
+ strict(hipe_bifs, write_u64, 2, Xs, fun (_) -> t_nil() end, Opaques);
+type(hipe_bifs, alloc_loader_state, 1, Xs, Opaques) ->
+ strict(hipe_bifs, alloc_loader_state, 1, Xs, fun (_) -> t_binary() end, Opaques);
+%%-- lists --------------------------------------------------------------------
+type(lists, all, 2, Xs, Opaques) ->
+ strict(lists, all, 2, Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> t_atom('true');
+ false ->
+ El = t_list_elements(L, Opaques),
+ case check_fun_application(F, [El], Opaques) of
+ ok ->
+ case t_is_cons(L, Opaques) of
+ true -> t_fun_range(F, Opaques);
+ false ->
+ %% The list can be empty.
+ t_sup(t_atom('true'), t_fun_range(F, Opaques))
+ end;
+ error ->
+ case t_is_cons(L, Opaques) of
+ true -> t_none();
+ false -> t_fun_range(F, Opaques)
+ end
+ end
+ end
+ end, Opaques);
+type(lists, any, 2, Xs, Opaques) ->
+ strict(lists, any, 2, Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> t_atom('false');
+ false ->
+ El = t_list_elements(L, Opaques),
+ case check_fun_application(F, [El], Opaques) of
+ ok ->
+ case t_is_cons(L, Opaques) of
+ true -> t_fun_range(F, Opaques);
+ false ->
+ %% The list can be empty
+ t_sup(t_atom('false'), t_fun_range(F, Opaques))
+ end;
+ error ->
+ case t_is_cons(L, Opaques) of
+ true -> t_none();
+ false -> t_fun_range(F, Opaques)
+ end
+ end
+ end
+ end, Opaques);
+type(lists, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias
+type(lists, delete, 2, Xs, Opaques) ->
+ strict(lists, delete, 2, Xs,
+ fun ([_, List]) ->
+ case t_is_cons(List, Opaques) of
+ true -> t_cons_tl(List);
+ false -> List
+ end
+ end, Opaques);
+type(lists, dropwhile, 2, Xs, Opaques) ->
+ strict(lists, dropwhile, 2, Xs,
+ fun ([F, X]) ->
+ case t_is_nil(X, Opaques) of
+ true -> t_nil();
+ false ->
+ X1 = t_list_elements(X, Opaques),
+ case check_fun_application(F, [X1], Opaques) of
+ ok ->
+ case t_atom_vals(t_fun_range(F, Opaques), Opaques) of
+ ['true'] ->
+ case t_is_none(t_inf(t_list(), X, Opaques)) of
+ true -> t_none();
+ false -> t_nil()
+ end;
+ ['false'] ->
+ case t_is_none(t_inf(t_list(), X, Opaques)) of
+ true -> t_none();
+ false -> X
+ end;
+ _ ->
+ t_inf(t_cons_tl(t_inf(X, t_cons(), Opaques)),
+ t_maybe_improper_list(), Opaques)
+ end;
+ error ->
+ case t_is_cons(X, Opaques) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end, Opaques);
+type(lists, filter, 2, Xs, Opaques) ->
+ strict(lists, filter, 2, Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> t_nil();
+ false ->
+ T = t_list_elements(L, Opaques),
+ case check_fun_application(F, [T], Opaques) of
+ ok ->
+ RangeVals = t_atom_vals(t_fun_range(F, Opaques), Opaques),
+ case RangeVals =:= ['false'] of
+ true -> t_nil();
+ false ->
+ case RangeVals =:= ['true'] of
+ true -> L;
+ false -> t_list(T)
+ end
+ end;
+ error ->
+ case t_is_cons(L, Opaques) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end, Opaques);
+type(lists, flatten, 1, Xs, Opaques) ->
+ strict(lists, flatten, 1, Xs,
+ fun ([L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> L; % (nil has undefined elements)
+ false ->
+ %% Avoiding infinite recursion is tricky
+ X1 = t_list_elements(L, Opaques),
+ case t_is_any(X1) of
+ true ->
+ t_list();
+ false ->
+ X2 = type(lists, flatten, 1, [t_inf(X1, t_list(), Opaques)]),
+ t_sup(t_list(t_subtract(X1, t_list())), X2)
+ end
+ end
+ end, Opaques);
+type(lists, flatmap, 2, Xs, Opaques) ->
+ strict(lists, flatmap, 2, Xs,
+ fun ([F, List]) ->
+ case t_is_nil(List, Opaques) of
+ true -> t_nil();
+ false ->
+ case
+ check_fun_application(F, [t_list_elements(List, Opaques)],
+ Opaques)
+ of
+ ok ->
+ R = t_fun_range(F, Opaques),
+ case t_is_nil(R) of
+ true -> t_nil();
+ false ->
+ Elems = t_list_elements(R, Opaques),
+ case t_is_cons(List, Opaques) of
+ true ->
+ case t_is_subtype(t_nil(), R) of
+ true -> t_list(Elems);
+ false -> t_nonempty_list(Elems)
+ end;
+ false -> t_list(Elems)
+ end
+ end;
+ error ->
+ case t_is_cons(List, Opaques) of
+ true -> t_none();
+ false -> t_nil()
+ end
+ end
+ end
+ end, Opaques);
+type(lists, foreach, 2, Xs, Opaques) ->
+ strict(lists, foreach, 2, Xs,
+ fun ([F, List]) ->
+ case t_is_cons(List, Opaques) of
+ true ->
+ case
+ check_fun_application(F, [t_list_elements(List, Opaques)],
+ Opaques)
+ of
+ ok -> t_atom('ok');
+ error -> t_none()
+ end;
+ false ->
+ t_atom('ok')
+ end
+ end, Opaques);
+type(lists, foldl, 3, Xs, Opaques) ->
+ strict(lists, foldl, 3, Xs,
+ fun ([F, Acc, List]) ->
+ case t_is_nil(List, Opaques) of
+ true -> Acc;
+ false ->
+ case
+ check_fun_application(F,
+ [t_list_elements(List, Opaques),Acc],
+ Opaques)
+ of
+ ok ->
+ case t_is_cons(List, Opaques) of
+ true -> t_fun_range(F, Opaques);
+ false -> t_sup(t_fun_range(F, Opaques), Acc)
+ end;
+ error ->
+ case t_is_cons(List, Opaques) 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) ->
+ 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) ->
+ strict(lists, keyfind, 3, Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z, Opaques),
+ Tuple = t_inf(t_tuple(), ListEs, Opaques),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ %% this BIF, contrary to lists:keysearch/3 does not
+ %% wrap its result in a 'value'-tagged tuple
+ Ret = t_sup(Tuple, t_atom('false')),
+ case t_is_any(X) of
+ true -> Ret;
+ false ->
+ case t_tuple_subtypes(Tuple, Opaques) of
+ unknown -> Ret;
+ List ->
+ case key_comparisons_fail(X, Y, List, Opaques) of
+ true -> t_atom('false');
+ false -> Ret
+ end
+ end
+ end
+ end
+ end, Opaques);
+type(lists, keymap, 3, Xs, Opaques) ->
+ strict(lists, keymap, 3, Xs,
+ fun ([F, _I, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> L;
+ false -> t_list(t_sup(t_fun_range(F, Opaques),
+ t_list_elements(L, Opaques)))
+ end
+ end, Opaques);
+type(lists, keymember, 3, Xs, Opaques) ->
+ strict(lists, keymember, 3, Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z, Opaques),
+ Tuple = t_inf(t_tuple(), ListEs, Opaques),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ case t_is_any(X) of
+ true -> t_boolean();
+ false ->
+ case t_tuple_subtypes(Tuple, Opaques) of
+ unknown -> t_boolean();
+ List ->
+ case key_comparisons_fail(X, Y, List, Opaques) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end
+ end
+ end
+ end, Opaques);
+type(lists, keymerge, 3, Xs, Opaques) ->
+ strict(lists, keymerge, 3, Xs,
+ fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end, Opaques);
+type(lists, keyreplace, 4, Xs, Opaques) ->
+ strict(lists, keyreplace, 4, Xs,
+ fun ([_K, _I, L, T]) ->
+ t_list(t_sup(t_list_elements(L, Opaques), T))
+ end, Opaques);
+type(lists, keysearch, 3, Xs, Opaques) ->
+ strict(lists, keysearch, 3, Xs,
+ fun ([X, Y, Z]) ->
+ ListEs = t_list_elements(Z, Opaques),
+ Tuple = t_inf(t_tuple(), ListEs, Opaques),
+ case t_is_none(Tuple) of
+ true -> t_atom('false');
+ false ->
+ Ret = t_sup(t_tuple([t_atom('value'), Tuple]),
+ t_atom('false')),
+ case t_is_any(X) of
+ true -> Ret;
+ false ->
+ case t_tuple_subtypes(Tuple, Opaques) of
+ unknown -> Ret;
+ List ->
+ case key_comparisons_fail(X, Y, List, Opaques) 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) ->
+ strict(lists, last, 1, Xs,
+ fun ([L]) -> t_list_elements(L, Opaques) end, Opaques);
+type(lists, map, 2, Xs, Opaques) ->
+ strict(lists, map, 2, Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> L;
+ false ->
+ El = t_list_elements(L, Opaques),
+ case t_is_cons(L, Opaques) of
+ true ->
+ case check_fun_application(F, [El], Opaques) of
+ ok -> t_nonempty_list(t_fun_range(F, Opaques));
+ error -> t_none()
+ end;
+ false ->
+ case check_fun_application(F, [El], Opaques) of
+ ok -> t_list(t_fun_range(F, Opaques));
+ error -> t_nil()
+ end
+ end
+ end
+ end, Opaques);
+type(lists, mapfoldl, 3, Xs, Opaques) ->
+ strict(lists, mapfoldl, 3, Xs,
+ fun ([F, Acc, List]) ->
+ case t_is_nil(List, Opaques) 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
+ true ->
+ case check_fun_application(F, [El, Acc], Opaques) of
+ ok ->
+ Fun = fun (RangeTuple) ->
+ [T1, T2] = t_tuple_args(RangeTuple, Opaques),
+ t_tuple([t_nonempty_list(T1), T2])
+ end,
+ t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]);
+ error ->
+ t_none()
+ end;
+ false ->
+ case check_fun_application(F, [El, Acc], Opaques) of
+ ok ->
+ Fun = fun (RangeTuple) ->
+ [T1, T2] = t_tuple_args(RangeTuple, Opaques),
+ t_tuple([t_list(T1), t_sup(Acc, T2)])
+ end,
+ t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]);
+ 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) ->
+ strict(lists, max, 1, Xs,
+ fun ([L]) -> t_list_elements(L, Opaques) end, Opaques);
+type(lists, member, 2, Xs, Opaques) ->
+ strict(lists, member, 2, Xs,
+ fun ([X, Y]) ->
+ Y1 = t_list_elements(Y, Opaques),
+ case t_is_none(t_inf(Y1, X, Opaques)) of
+ true -> t_atom('false');
+ false -> t_boolean()
+ end
+ end, Opaques);
+%% type(lists, merge, 1, Xs, Opaques) ->
+type(lists, merge, 2, Xs, Opaques) ->
+ strict(lists, merge, 2, Xs,
+ fun ([L1, L2]) ->
+ case t_is_none(L1) of
+ true -> L2;
+ false ->
+ case t_is_none(L2) of
+ true -> L1;
+ false -> t_sup(L1, L2)
+ end
+ end
+ end, Opaques);
+type(lists, min, 1, Xs, Opaques) ->
+ strict(lists, min, 1, Xs,
+ fun ([L]) -> t_list_elements(L, Opaques) end, Opaques);
+type(lists, nth, 2, Xs, Opaques) ->
+ strict(lists, nth, 2, Xs,
+ fun ([_, Y]) -> t_list_elements(Y, Opaques) end, Opaques);
+type(lists, nthtail, 2, Xs, Opaques) ->
+ strict(lists, nthtail, 2, Xs,
+ fun ([_, Y]) -> t_sup(Y, t_list()) end, Opaques);
+type(lists, partition, 2, Xs, Opaques) ->
+ strict(lists, partition, 2, Xs,
+ fun ([F, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> t_tuple([L,L]);
+ false ->
+ El = t_list_elements(L, Opaques),
+ case check_fun_application(F, [El], Opaques) of
+ error ->
+ case t_is_cons(L, Opaques) of
+ true -> t_none();
+ false -> t_tuple([t_nil(), t_nil()])
+ end;
+ ok ->
+ case t_atom_vals(t_fun_range(F, Opaques), Opaques) of
+ ['true'] -> t_tuple([L, t_nil()]);
+ ['false'] -> t_tuple([t_nil(), L]);
+ [_, _] ->
+ L2 = t_list(El),
+ t_tuple([L2, L2])
+ 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) ->
+ 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) ->
+ strict(lists, sort, 2, Xs,
+ fun ([F, L]) ->
+ R = t_fun_range(F, Opaques),
+ case t_is_boolean(R, Opaques) of
+ true -> L;
+ false ->
+ case t_is_nil(L, Opaques) of
+ true -> t_nil();
+ false -> t_none()
+ end
+ end
+ end, Opaques);
+type(lists, split, 2, Xs, Opaques) ->
+ strict(lists, split, 2, Xs,
+ fun ([_, L]) ->
+ case t_is_nil(L, Opaques) of
+ true -> t_tuple([L, L]);
+ false ->
+ T = t_list_elements(L, Opaques),
+ t_tuple([t_list(T), t_list(T)])
+ end
+ end, Opaques);
+type(lists, splitwith, 2, Xs, _Opaques) ->
+ T1 = type(lists, takewhile, 2, Xs),
+ T2 = type(lists, dropwhile, 2, Xs),
+ case t_is_none(T1) orelse t_is_none(T2) of
+ true -> t_none();
+ false -> t_tuple([T1, T2])
+ end;
+type(lists, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias
+type(lists, takewhile, 2, Xs, Opaques) ->
+ strict(lists, takewhile, 2, Xs,
+ fun([F, L]) ->
+ case t_is_none(t_inf(t_list(), L, Opaques)) of
+ false -> type(lists, filter, 2, Xs);
+ true ->
+ %% This works for non-proper lists as well.
+ El = t_list_elements(L, Opaques),
+ 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) ->
+ strict(lists, unzip, 1, Xs,
+ fun ([Ps]) ->
+ case t_is_nil(Ps, Opaques) of
+ true ->
+ t_tuple([t_nil(), t_nil()]);
+ false -> % Ps is a proper list of pairs
+ TupleTypes = t_tuple_subtypes(t_list_elements(Ps, Opaques),
+ Opaques),
+ lists:foldl(fun(Tuple, Acc) ->
+ [A, B] = t_tuple_args(Tuple, Opaques),
+ t_sup(t_tuple([t_list(A), t_list(B)]), Acc)
+ end, t_none(), TupleTypes)
+ end
+ end, Opaques);
+type(lists, unzip3, 1, Xs, Opaques) ->
+ strict(lists, unzip3, 1, Xs,
+ fun ([Ts]) ->
+ case t_is_nil(Ts, Opaques) of
+ true ->
+ t_tuple([t_nil(), t_nil(), t_nil()]);
+ false -> % Ps is a proper list of triples
+ TupleTypes = t_tuple_subtypes(t_list_elements(Ts, Opaques),
+ Opaques),
+ lists:foldl(fun(T, Acc) ->
+ [A, B, C] = t_tuple_args(T, Opaques),
+ t_sup(t_tuple([t_list(A),
+ t_list(B),
+ t_list(C)]),
+ Acc)
+ end, t_none(), TupleTypes)
+ end
+ end, Opaques);
+type(lists, zip, 2, Xs, Opaques) ->
+ strict(lists, zip, 2, Xs,
+ fun ([As, Bs]) ->
+ case (t_is_nil(As, Opaques) orelse t_is_nil(Bs, Opaques)) of
+ true -> t_nil();
+ false ->
+ A = t_list_elements(As, Opaques),
+ B = t_list_elements(Bs, Opaques),
+ t_list(t_tuple([A, B]))
+ end
+ end, Opaques);
+type(lists, zip3, 3, Xs, Opaques) ->
+ 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))
+ of
+ true -> t_nil();
+ false ->
+ A = t_list_elements(As, Opaques),
+ B = t_list_elements(Bs, Opaques),
+ C = t_list_elements(Cs, Opaques),
+ t_list(t_tuple([A, B, C]))
+ end
+ end, Opaques);
+type(lists, zipwith, 3, Xs, Opaques) ->
+ strict(lists, zipwith, 3, Xs,
+ fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F, Opaques)),
+ t_nil()) end, Opaques);
+type(lists, zipwith3, 4, Xs, Opaques) ->
+ strict(lists, zipwith3, 4, Xs,
+ fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)),
+ t_nil()) end, Opaques);
+
+%%-- maps ---------------------------------------------------------------------
+type(maps, from_list, 1, Xs, Opaques) ->
+ strict(maps, from_list, 1, Xs,
+ fun ([List]) ->
+ case t_is_nil(List, Opaques) of
+ true -> t_from_term(#{});
+ false ->
+ T = t_list_elements(List, Opaques),
+ case t_tuple_subtypes(T, Opaques) of
+ unknown -> t_map();
+ Stypes when length(Stypes) >= 1 ->
+ t_sup([begin
+ [K, V] = t_tuple_args(Args, Opaques),
+ t_map([], K, V)
+ end || Args <- Stypes])
+ end
+ end
+ end, Opaques);
+type(maps, get, 2, Xs, Opaques) ->
+ strict(maps, get, 2, Xs,
+ fun ([Key, Map]) ->
+ t_map_get(Key, Map, Opaques)
+ end, Opaques);
+type(maps, is_key, 2, Xs, Opaques) ->
+ strict(maps, is_key, 2, Xs,
+ fun ([Key, Map]) ->
+ t_map_is_key(Key, Map, Opaques)
+ end, Opaques);
+type(maps, merge, 2, Xs, Opaques) ->
+ 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),
+ 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),
+ t_sup(ADefK, BDefK), t_sup(ADefV, BDefV))
+ end, Opaques);
+type(maps, put, 3, Xs, Opaques) ->
+ strict(maps, put, 3, Xs,
+ fun ([Key, Value, Map]) ->
+ t_map_put({Key, Value}, Map, Opaques)
+ end, Opaques);
+type(maps, remove, 2, Xs, Opaques) ->
+ strict(maps, remove, 2, Xs,
+ fun ([Key, Map]) ->
+ t_map_remove(Key, Map, Opaques)
+ end, Opaques);
+type(maps, size, 1, Xs, Opaques) ->
+ strict(maps, size, 1, Xs,
+ fun ([Map]) ->
+ Mand = [E || E={_,mandatory,_} <- t_map_entries(Map, Opaques)],
+ LowerBound = length(Mand),
+ case t_is_none(t_map_def_key(Map, Opaques)) of
+ false -> t_from_range(LowerBound, pos_inf);
+ true ->
+ Opt = [E || E={_,optional,_} <- t_map_entries(Map, Opaques)],
+ UpperBound = LowerBound + length(Opt),
+ t_from_range(LowerBound, UpperBound)
+ end
+ end, Opaques);
+type(maps, update, 3, Xs, Opaques) ->
+ strict(maps, update, 3, Xs,
+ fun ([Key, Value, Map]) ->
+ t_map_update({Key, Value}, Map, Opaques)
+ end, Opaques);
+
+%%-----------------------------------------------------------------------------
+type(M, F, A, Xs, _O) when is_atom(M), is_atom(F),
+ is_integer(A), 0 =< A, A =< 255 ->
+ strict(Xs, t_any()). % safe approximation for all functions.
+
+
+%%-----------------------------------------------------------------------------
+%% Auxiliary functions
+%%-----------------------------------------------------------------------------
+
+strict(M, F, A, Xs, Fun, Opaques) ->
+ Ts = arg_types(M, F, A),
+ %% io:format("inf lists arg~nXs: ~p~nTs: ~p ~n", [Xs, Ts]),
+ Xs1 = inf_lists(Xs, Ts, Opaques),
+ %% io:format("inf lists return ~p ~n", [Xs1]),
+ case any_is_none_or_unit(Xs1) of
+ true -> t_none();
+ false -> Fun(Xs1)
+ end.
+
+strict2(Xs, X) ->
+ case any_is_none_or_unit(Xs) of
+ true -> t_none();
+ false -> X
+ end.
+
+strict(Xs, X) ->
+ case any_is_none_or_unit(Xs) of
+ true -> t_none();
+ 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 ->
+ [A | any_list(N - 1, A)];
+any_list(0, _) ->
+ [].
+
+list_replace(N, E, [X | Xs]) when N > 1 ->
+ [X | list_replace(N - 1, E, Xs)];
+list_replace(1, E, [_X | Xs]) ->
+ [E | Xs].
+
+any_is_none_or_unit(Ts) ->
+ lists:any(fun erl_types:t_is_none_or_unit/1, Ts).
+
+check_guard([X], Test, Type, Opaques) ->
+ check_guard_single(X, Test, Type, Opaques).
+
+check_guard_single(X, Test, Type, Opaques) ->
+ 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;
+ false -> t_boolean()
+ end
+ end.
+
+check_record_tag(Tag, Y, Opaques) ->
+ case t_is_atom(Tag, Opaques) of
+ false ->
+ TagAtom = t_inf(Tag, t_atom(), Opaques),
+ case t_is_none(TagAtom) of
+ true ->
+ case t_has_opaque_subtype(Tag, Opaques) of
+ true -> t_none();
+ false -> t_atom('false')
+ end;
+ false -> t_boolean()
+ end;
+ true ->
+ case t_atom_vals(Tag, Opaques) of
+ [RealTag] ->
+ case t_atom_vals(Y, Opaques) of
+ [RealTag] -> t_atom('true');
+ _ -> t_boolean()
+ end;
+ _ -> t_boolean()
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Functions for range analysis
+%%-----------------------------------------------------------------------------
+
+infinity_max([]) -> empty;
+infinity_max([H|T]) ->
+ if H =:= empty ->
+ infinity_max(T);
+ true ->
+ lists:foldl(
+ fun (Elem, Max) ->
+ Geq = infinity_geq(Elem, Max),
+ if not Geq orelse (Elem =:= empty) ->
+ Max;
+ true ->
+ Elem
+ end
+ end,
+ H,
+ T)
+ end.
+
+infinity_min([]) -> empty;
+infinity_min([H|T]) ->
+ if H =:= empty ->
+ infinity_min(T);
+ true ->
+ lists:foldl(fun (Elem, Min) ->
+ Geq = infinity_geq(Elem, Min),
+ if Geq orelse (Elem =:= empty) ->
+ Min;
+ true ->
+ Elem
+ end
+ end,
+ H,
+ T)
+ end.
+
+-type inf_integer() :: 'neg_inf' | 'pos_inf' | integer().
+
+-spec infinity_abs('pos_inf' | 'neg_inf') -> 'pos_inf'
+ ; (integer()) -> non_neg_integer().
+
+infinity_abs(pos_inf) -> pos_inf;
+infinity_abs(neg_inf) -> pos_inf;
+infinity_abs(Number) when is_integer(Number) -> abs(Number).
+
+%% span_zero(Range) ->
+%% infinity_geq(0, number_min(Range)) and infinity_geq(number_max(Range), 0).
+
+infinity_inv(pos_inf) -> neg_inf;
+infinity_inv(neg_inf) -> pos_inf;
+infinity_inv(Number) when is_integer(Number) -> -Number.
+
+infinity_band(neg_inf, Type2) -> Type2;
+%% infinity_band(Type1, neg_inf) -> Type1;
+infinity_band(pos_inf, Type2) -> Type2;
+%% infinity_band(Type1, pos_inf) -> Type1;
+infinity_band(Type1, Type2) when is_integer(Type1), is_integer(Type2) ->
+ Type1 band Type2.
+
+infinity_bor(neg_inf, _Type2) -> neg_inf;
+%% infinity_bor(_Type1, neg_inf) -> neg_inf;
+infinity_bor(pos_inf, _Type2) -> pos_inf;
+%% infinity_bor(_Type1, pos_inf) -> pos_inf;
+infinity_bor(Type1, Type2) when is_integer(Type1), is_integer(Type2) ->
+ Type1 bor Type2.
+
+infinity_div(pos_inf, pos_inf) -> [0, pos_inf];
+infinity_div(pos_inf, neg_inf) -> [neg_inf, 0];
+infinity_div(neg_inf, neg_inf) -> [0, pos_inf];
+infinity_div(neg_inf, pos_inf) -> [neg_inf, 0];
+infinity_div(pos_inf, Number) when is_integer(Number), Number > 0 -> pos_inf;
+infinity_div(pos_inf, Number) when is_integer(Number), Number < 0 -> neg_inf;
+infinity_div(neg_inf, Number) when is_integer(Number), Number > 0 -> neg_inf;
+infinity_div(neg_inf, Number) when is_integer(Number), Number < 0 -> pos_inf;
+infinity_div(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf;
+infinity_div(Number, pos_inf) when is_integer(Number), Number < 0 -> neg_inf;
+infinity_div(Number, neg_inf) when is_integer(Number), Number >= 0 -> neg_inf;
+infinity_div(Number, neg_inf) when is_integer(Number), Number < 0 -> pos_inf;
+infinity_div(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Number1 div Number2.
+
+infinity_bsl(pos_inf, _) -> pos_inf;
+infinity_bsl(neg_inf, _) -> neg_inf;
+infinity_bsl(0, pos_inf) -> 0;
+infinity_bsl(Number, pos_inf) when is_integer(Number), Number > 0 -> pos_inf;
+infinity_bsl(Number, pos_inf) when is_integer(Number) -> neg_inf;
+infinity_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0;
+infinity_bsl(Number, neg_inf) when is_integer(Number) -> -1;
+infinity_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ Bits = ?BITS,
+ if Number2 > (Bits * 2) -> infinity_bsl(Number1, pos_inf);
+ Number2 < (-Bits * 2) -> infinity_bsl(Number1, neg_inf);
+ true -> Number1 bsl Number2
+ end.
+
+infinity_geq(pos_inf, _) -> true;
+infinity_geq(_, pos_inf) -> false;
+infinity_geq(_, neg_inf) -> true;
+infinity_geq(neg_inf, _) -> false;
+infinity_geq(A, B) when is_integer(A), is_integer(B) -> A >= B.
+
+-spec infinity_add(inf_integer(), inf_integer()) -> inf_integer().
+
+infinity_add(pos_inf, _Number) -> pos_inf;
+infinity_add(neg_inf, _Number) -> neg_inf;
+infinity_add(_Number, pos_inf) -> pos_inf;
+infinity_add(_Number, neg_inf) -> neg_inf;
+infinity_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) ->
+ try Number1 + Number2
+ catch
+ error:system_limit when Number1 < 0 -> neg_inf;
+ error:system_limit -> pos_inf
+ end.
+
+infinity_mult(neg_inf, Number) ->
+ Greater = infinity_geq(Number, 0),
+ if Greater -> neg_inf;
+ true -> pos_inf
+ end;
+infinity_mult(pos_inf, Number) -> infinity_inv(infinity_mult(neg_inf, Number));
+infinity_mult(Number, pos_inf) -> infinity_inv(infinity_mult(neg_inf, Number));
+infinity_mult(Number, neg_inf) -> infinity_mult(neg_inf, Number);
+infinity_mult(Number1, Number2) when is_integer(Number1), is_integer(Number2)->
+ try Number1 * Number2
+ catch
+ error:system_limit ->
+ if (Number1 >= 0) =:= (Number2 >= 0) -> pos_inf;
+ true -> neg_inf
+ end
+ end.
+
+width({Min, Max}) -> infinity_max([width(Min), width(Max)]);
+width(pos_inf) -> pos_inf;
+width(neg_inf) -> pos_inf;
+width(X) when is_integer(X), X >= 0 -> poswidth(X, 0);
+width(X) when is_integer(X), X < 0 -> negwidth(X, 0).
+
+poswidth(X, N) ->
+ case X < (1 bsl N) of
+ true -> N;
+ false -> poswidth(X, N+1)
+ end.
+
+negwidth(X, N) ->
+ case X >= (-1 bsl N) of
+ true -> N;
+ false -> negwidth(X, N+1)
+ end.
+
+arith_bnot(X1, Opaques) ->
+ case t_is_integer(X1, Opaques) of
+ false -> error;
+ true ->
+ Min1 = number_min(X1, Opaques),
+ Max1 = number_max(X1, Opaques),
+ {ok, t_from_range(infinity_add(infinity_inv(Max1), -1),
+ infinity_add(infinity_inv(Min1), -1))}
+ end.
+
+arith_abs(X1, Opaques) ->
+ case t_is_integer(X1, Opaques) of
+ false ->
+ case t_is_float(X1, Opaques) of
+ true -> t_float();
+ false -> t_number()
+ end;
+ true ->
+ Min1 = number_min(X1, Opaques),
+ Max1 = number_max(X1, Opaques),
+ {NewMin, NewMax} =
+ case infinity_geq(Min1, 0) of
+ true -> {Min1, Max1};
+ false ->
+ NegMin1 = infinity_inv(Min1),
+ NegMax1 = infinity_inv(Max1),
+ case infinity_geq(Max1, 0) of
+ true -> {0, max(NegMin1, Max1)};
+ false -> {NegMax1, NegMin1}
+ end
+ end,
+ t_from_range(NewMin, NewMax)
+ end.
+
+arith_mult(Min1, Max1, Min2, Max2) ->
+ Tmp_list = [infinity_mult(Min1, Min2), infinity_mult(Min1, Max2),
+ infinity_mult(Max1, Min2), infinity_mult(Max1, Max2)],
+ {infinity_min(Tmp_list), infinity_max(Tmp_list)}.
+
+arith_div(_Min1, _Max1, 0, 0) ->
+ %% Signal failure.
+ {pos_inf, neg_inf};
+arith_div(Min1, Max1, Min2, Max2) ->
+ %% 0 is not an accepted divisor.
+ NewMin2 = if Min2 =:= 0 -> 1;
+ true -> Min2
+ end,
+ NewMax2 = if Max2 =:= 0 -> -1;
+ true -> Max2
+ end,
+ Tmp_list = lists:flatten([infinity_div(Min1, NewMin2),
+ infinity_div(Min1, NewMax2),
+ infinity_div(Max1, NewMin2),
+ infinity_div(Max1, NewMax2)]),
+ {infinity_min(Tmp_list), infinity_max(Tmp_list)}.
+
+arith_rem(Min1, Max1, Min2, Max2) ->
+ Min1_geq_zero = infinity_geq(Min1, 0),
+ Max1_leq_zero = infinity_geq(0, Max1),
+ Max_range2 = infinity_max([infinity_abs(Min2), infinity_abs(Max2)]),
+ New_min =
+ if Min1_geq_zero -> 0;
+ Max_range2 =:= 0 -> 0;
+ true -> infinity_add(infinity_inv(Max_range2), 1)
+ end,
+ New_max =
+ if Max1_leq_zero -> 0;
+ Max_range2 =:= 0 -> 0;
+ true -> infinity_add(Max_range2, -1)
+ end,
+ {New_min, New_max}.
+
+arith_bsl(Min1, Max1, Min2, Max2) ->
+ case infinity_geq(Min1, 0) of
+ true -> {infinity_bsl(Min1, Min2), infinity_bsl(Max1, Max2)};
+ false ->
+ case infinity_geq(Max1, 0) of
+ true -> {infinity_bsl(Min1, Max2), infinity_bsl(Max1, Max2)};
+ false -> {infinity_bsl(Min1, Max2), infinity_bsl(Max2, Min2)}
+ end
+ end.
+
+arith_band_range_set({Min, Max}, [Int|IntList]) ->
+ SafeAnd = lists:foldl(
+ fun (IntFromSet, SafeAndAcc) ->
+ IntFromSet bor SafeAndAcc
+ end,
+ Int,
+ IntList),
+ {infinity_band(Min, SafeAnd), infinity_band(Max, SafeAnd)}.
+
+arith_bor_range_set({Min, Max}, [Int|IntList]) ->
+ SafeAnd = lists:foldl(
+ fun (IntFromSet, SafeAndAcc) ->
+ IntFromSet band SafeAndAcc
+ end,
+ Int,
+ 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),
+ case {L1 =:= unknown, L2 =:= unknown} of
+ {true, false} ->
+ arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2);
+ {false, true} ->
+ arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L1);
+ {true, true} ->
+ 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),
+ case {L1 =:= unknown, L2 =:= unknown} of
+ {true, false} ->
+ arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2);
+ {false, true} ->
+ arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L1);
+ {true, true} ->
+ arith_bor_ranges(Min1, Max1, Min2, Max2)
+ end.
+
+arith_band_ranges(Min1, Max1, Min2, Max2) ->
+ Width = infinity_min([width({Min1, Max1}), width({Min2, Max2})]),
+ Min =
+ case infinity_geq(Min1, 0) orelse infinity_geq(Min2, 0) of
+ true -> 0;
+ false -> infinity_bsl(-1, Width)
+ end,
+ Max =
+ case infinity_geq(Max1, 0) orelse infinity_geq(Max2, 0) of
+ true -> infinity_add(infinity_bsl(1, Width), -1);
+ false -> 0
+ end,
+ {Min, Max}.
+
+arith_bor_ranges(Min1, Max1, Min2, Max2) ->
+ Width = infinity_max([width({Min1, Max1}), width({Min2, Max2})]),
+ Min =
+ case infinity_geq(Min1, 0) andalso infinity_geq(Min2, 0) of
+ true -> 0;
+ false -> infinity_bsl(-1, Width)
+ end,
+ Max =
+ case infinity_geq(Max1, 0) andalso infinity_geq(Max2, 0) of
+ true -> infinity_add(infinity_bsl(1, Width), -1);
+ false -> -1
+ 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
+ false -> error;
+ true ->
+ L1 = t_number_vals(X1, Opaques),
+ L2 = t_number_vals(X2, Opaques),
+ 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),
+ {NewMin, NewMax} =
+ case Op of
+ '+' -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)};
+ '-' -> {infinity_add(Min1, infinity_inv(Max2)),
+ infinity_add(Max1, infinity_inv(Min2))};
+ '*' -> arith_mult(Min1, Max1, Min2, Max2);
+ 'div' -> arith_div(Min1, Max1, Min2, Max2);
+ 'rem' -> arith_rem(Min1, Max1, Min2, Max2);
+ 'bsl' -> arith_bsl(Min1, Max1, Min2, Max2);
+ '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);
+ '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
+ %% exception; for example, when trying to evaluate 1 bsl 100000000.
+ try case Op of
+ '+' -> [X + Y || X <- L1, Y <- L2];
+ '-' -> [X - Y || X <- L1, Y <- L2];
+ '*' -> [X * Y || X <- L1, Y <- L2];
+ 'div' -> [X div Y || X <- L1, Y <- L2, Y =/= 0];
+ 'rem' -> [X rem Y || X <- L1, Y <- L2, Y =/= 0];
+ 'bsl' -> [X bsl Y || X <- L1, Y <- L2];
+ 'bsr' -> [X bsr Y || X <- L1, Y <- L2];
+ 'band' -> [X band Y || X <- L1, Y <- L2];
+ 'bor' -> [X bor Y || X <- L1, Y <- L2];
+ 'bxor' -> [X bxor Y || X <- L1, Y <- L2]
+ end of
+ AllVals ->
+ {ok, t_integers(ordsets:from_list(AllVals))}
+ catch
+ error:system_limit -> error
+ end
+ end
+ end.
+
+%%=============================================================================
+%% Comparison of terms
+%%=============================================================================
+
+compare(Op, Lhs, Rhs, Opaques) ->
+ case t_is_none(t_inf(Lhs, Rhs, Opaques)) 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()
+ end
+ end.
+
+always_smaller(Type1, Type2, Opaques) ->
+ {Min1, Max1} = type_ranks(Type1, Opaques),
+ {Min2, Max2} = type_ranks(Type2, Opaques),
+ if Max1 < Min2 -> t_atom('true');
+ Min1 > Max2 -> t_atom('false');
+ true -> t_boolean()
+ end.
+
+type_ranks(Type, Opaques) ->
+ type_ranks(Type, 1, 0, 0, type_order(), Opaques).
+
+type_ranks(_Type, _I, Min, Max, [], _Opaques) -> {Min, Max};
+type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) ->
+ {NewMin, NewMax} =
+ case t_is_none(t_inf(Type, TypeClass, Opaques)) 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_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) ->
+ 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))
+ end, TupleList).
+
+%%=============================================================================
+
+-spec arg_types(atom(), atom(), arity()) -> arg_types() | 'unknown'.
+
+%%------- erlang --------------------------------------------------------------
+arg_types(erlang, '!', 2) ->
+ Pid = t_sup([t_pid(), t_port(), t_atom(),
+ t_tuple([t_atom(), t_node()])]),
+ [Pid, t_any()];
+arg_types(erlang, '==', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '/=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=:=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=/=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '>', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '>=', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '<', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '=<', 2) ->
+ [t_any(), t_any()];
+arg_types(erlang, '+', 1) ->
+ [t_number()];
+arg_types(erlang, '+', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '++', 2) ->
+ [t_list(), t_any()];
+arg_types(erlang, '-', 1) ->
+ [t_number()];
+arg_types(erlang, '-', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '--', 2) ->
+ [t_list(), t_list()];
+arg_types(erlang, '*', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, '/', 2) ->
+ [t_number(), t_number()];
+arg_types(erlang, 'div', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'rem', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'and', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'or', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'xor', 2) ->
+ [t_boolean(), t_boolean()];
+arg_types(erlang, 'not', 1) ->
+ [t_boolean()];
+arg_types(erlang, 'band', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bor', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bxor', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bsr', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bsl', 2) ->
+ [t_integer(), t_integer()];
+arg_types(erlang, 'bnot', 1) ->
+ [t_integer()];
+%% Guard bif, needs to be here.
+arg_types(erlang, abs, 1) ->
+ [t_number()];
+arg_types(erlang, append, 2) ->
+ arg_types(erlang, '++', 2);
+arg_types(erlang, apply, 2) ->
+ [t_sup(t_tuple([t_module(),
+ t_atom()]),
+ t_fun()),
+ t_list()];
+arg_types(erlang, apply, 3) ->
+ [t_sup(t_atom(), t_tuple()), t_atom(), t_list()];
+%% Guard bif, needs to be here.
+arg_types(erlang, binary_part, 2) ->
+ [t_binary(), t_tuple([t_non_neg_integer(), t_integer()])];
+%% Guard bif, needs to be here.
+arg_types(erlang, binary_part, 3) ->
+ [t_binary(), t_non_neg_integer(), t_integer()];
+%% Guard bif, needs to be here.
+arg_types(erlang, bit_size, 1) ->
+ [t_bitstr()];
+%% Guard bif, needs to be here.
+arg_types(erlang, byte_size, 1) ->
+ [t_bitstr()];
+%% Guard bif, needs to be here.
+arg_types(erlang, ceil, 1) ->
+ [t_number()];
+arg_types(erlang, halt, 0) ->
+ [];
+arg_types(erlang, halt, 1) ->
+ [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()])];
+arg_types(erlang, halt, 2) ->
+ [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()]),
+ t_list(t_tuple([t_atom('flush'), t_boolean()]))];
+arg_types(erlang, error, 1) ->
+ [t_any()];
+arg_types(erlang, error, 2) ->
+ [t_any(), t_list()];
+arg_types(erlang, exit, 1) ->
+ [t_any()];
+%% Guard bif, needs to be here.
+arg_types(erlang, element, 2) ->
+ [t_pos_fixnum(), t_tuple()];
+%% Guard bif, needs to be here.
+arg_types(erlang, float, 1) ->
+ [t_number()];
+%% Guard bif, needs to be here.
+arg_types(erlang, floor, 1) ->
+ [t_number()];
+%% Primop, needs to be somewhere.
+arg_types(erlang, build_stacktrace, 0) ->
+ [];
+%% Guard bif, needs to be here.
+arg_types(erlang, hd, 1) ->
+ [t_cons()];
+arg_types(erlang, info, 1) ->
+ arg_types(erlang, system_info, 1); % alias
+arg_types(erlang, is_atom, 1) ->
+ [t_any()];
+arg_types(erlang, is_binary, 1) ->
+ [t_any()];
+arg_types(erlang, is_bitstring, 1) ->
+ [t_any()];
+arg_types(erlang, is_boolean, 1) ->
+ [t_any()];
+arg_types(erlang, is_float, 1) ->
+ [t_any()];
+arg_types(erlang, is_function, 1) ->
+ [t_any()];
+arg_types(erlang, is_function, 2) ->
+ [t_any(), t_arity()];
+arg_types(erlang, is_integer, 1) ->
+ [t_any()];
+arg_types(erlang, is_list, 1) ->
+ [t_any()];
+arg_types(erlang, is_map, 1) ->
+ [t_any()];
+arg_types(erlang, is_map_key, 2) ->
+ [t_any(), t_map()];
+arg_types(erlang, is_number, 1) ->
+ [t_any()];
+arg_types(erlang, is_pid, 1) ->
+ [t_any()];
+arg_types(erlang, is_port, 1) ->
+ [t_any()];
+arg_types(erlang, is_record, 2) ->
+ [t_any(), t_atom()];
+arg_types(erlang, is_record, 3) ->
+ [t_any(), t_atom(), t_non_neg_fixnum()];
+arg_types(erlang, is_reference, 1) ->
+ [t_any()];
+arg_types(erlang, is_tuple, 1) ->
+ [t_any()];
+%% Guard bif, needs to be here.
+arg_types(erlang, length, 1) ->
+ [t_list()];
+%% Guard bif, needs to be here.
+arg_types(erlang, map_size, 1) ->
+ [t_map()];
+%% Guard bif, needs to be here.
+arg_types(erlang, map_get, 2) ->
+ [t_any(), t_map()];
+arg_types(erlang, make_fun, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, make_tuple, 2) ->
+ [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument
+arg_types(erlang, make_tuple, 3) ->
+ [t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))];
+arg_types(erlang, nif_error, 1) ->
+ [t_any()];
+arg_types(erlang, nif_error, 2) ->
+ [t_any(), t_list()];
+%% Guard bif, needs to be here.
+arg_types(erlang, node, 0) ->
+ [];
+%% Guard bif, needs to be here.
+arg_types(erlang, node, 1) ->
+ [t_identifier()];
+%% Guard bif, needs to be here.
+arg_types(erlang, round, 1) ->
+ [t_number()];
+%% Guard bif, needs to be here.
+arg_types(erlang, self, 0) ->
+ [];
+arg_types(erlang, setelement, 3) ->
+ [t_pos_integer(), t_tuple(), t_any()];
+%% Guard bif, needs to be here.
+arg_types(erlang, size, 1) ->
+ [t_sup(t_tuple(), t_binary())];
+arg_types(erlang, subtract, 2) ->
+ arg_types(erlang, '--', 2);
+arg_types(erlang, system_info, 1) ->
+ [t_sup([t_atom(), % documented
+ t_tuple([t_atom(), t_any()]), % documented
+ t_tuple([t_atom(), t_atom(), t_any()]),
+ t_tuple([t_atom(allocator_sizes), t_reference(), t_any()])])];
+arg_types(erlang, throw, 1) ->
+ [t_any()];
+%% Guard bif, needs to be here.
+arg_types(erlang, tl, 1) ->
+ [t_cons()];
+%% Guard bif, needs to be here.
+arg_types(erlang, trunc, 1) ->
+ [t_number()];
+%% Guard bif, needs to be here.
+arg_types(erlang, tuple_size, 1) ->
+ [t_tuple()];
+arg_types(erlang, tuple_to_list, 1) ->
+ [t_tuple()];
+%%------- hipe_bifs -----------------------------------------------------------
+arg_types(hipe_bifs, add_ref, 2) ->
+ [t_mfa(), t_tuple([t_mfa(),
+ t_integer(),
+ t_sup(t_atom('call'), t_atom('load_mfa')),
+ t_trampoline(),
+ t_binary()])];
+arg_types(hipe_bifs, alloc_data, 3) ->
+ [t_integer(), t_integer(), t_binary()];
+arg_types(hipe_bifs, array, 2) ->
+ [t_non_neg_fixnum(), t_immediate()];
+arg_types(hipe_bifs, array_length, 1) ->
+ [t_immarray()];
+arg_types(hipe_bifs, array_sub, 2) ->
+ [t_immarray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, array_update, 3) ->
+ [t_immarray(), t_non_neg_fixnum(), t_immediate()];
+arg_types(hipe_bifs, atom_to_word, 1) ->
+ [t_atom()];
+arg_types(hipe_bifs, bif_address, 3) ->
+ [t_atom(), t_atom(), t_arity()];
+arg_types(hipe_bifs, bitarray, 2) ->
+ [t_non_neg_fixnum(), t_boolean()];
+arg_types(hipe_bifs, bitarray_sub, 2) ->
+ [t_bitarray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, bitarray_update, 3) ->
+ [t_bytearray(), t_non_neg_fixnum(), t_boolean()];
+arg_types(hipe_bifs, bytearray, 2) ->
+ [t_non_neg_fixnum(), t_byte()];
+arg_types(hipe_bifs, bytearray_sub, 2) ->
+ [t_bytearray(), t_non_neg_fixnum()];
+arg_types(hipe_bifs, bytearray_update, 3) ->
+ [t_bytearray(), t_non_neg_fixnum(), t_byte()];
+arg_types(hipe_bifs, call_count_clear, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_get, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_off, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, call_count_on, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, check_crc, 1) ->
+ [t_crc32()];
+arg_types(hipe_bifs, enter_code, 3) ->
+ [t_binary(), t_sup(t_nil(), t_tuple()), t_binary()];
+arg_types(hipe_bifs, enter_sdesc, 2) ->
+ [t_tuple([t_integer(), t_integer(), t_integer(), t_integer(), t_integer(), t_mfa()]),
+ t_binary()];
+arg_types(hipe_bifs, find_na_or_make_stub, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, fun_to_address, 1) ->
+ [t_mfa()];
+arg_types(hipe_bifs, get_fe, 2) ->
+ [t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])];
+arg_types(hipe_bifs, get_rts_param, 1) ->
+ [t_fixnum()];
+arg_types(hipe_bifs, merge_term, 1) ->
+ [t_any()];
+arg_types(hipe_bifs, nstack_used_size, 0) ->
+ [];
+arg_types(hipe_bifs, patch_call, 3) ->
+ [t_integer(), t_integer(), t_trampoline()];
+arg_types(hipe_bifs, patch_insn, 3) ->
+ [t_integer(), t_integer(), t_insn_type()];
+arg_types(hipe_bifs, primop_address, 1) ->
+ [t_atom()];
+arg_types(hipe_bifs, ref, 1) ->
+ [t_immediate()];
+arg_types(hipe_bifs, ref_get, 1) ->
+ [t_hiperef()];
+arg_types(hipe_bifs, ref_set, 2) ->
+ [t_hiperef(), t_immediate()];
+arg_types(hipe_bifs, set_funinfo_native_address, 3) ->
+ arg_types(hipe_bifs, set_native_address, 3);
+arg_types(hipe_bifs, commit_patch_load, 1) ->
+ [t_binary()];
+arg_types(hipe_bifs, set_native_address, 3) ->
+ [t_mfa(), t_integer(), t_boolean()];
+arg_types(hipe_bifs, set_native_address_in_fe, 2) ->
+ [t_integer(), t_integer()];
+arg_types(hipe_bifs, system_crc, 0) ->
+ [];
+arg_types(hipe_bifs, term_to_word, 1) ->
+ [t_any()];
+arg_types(hipe_bifs, write_u8, 2) ->
+ [t_integer(), t_byte()];
+arg_types(hipe_bifs, write_u32, 2) ->
+ [t_integer(), t_integer()];
+arg_types(hipe_bifs, write_u64, 2) ->
+ [t_integer(), t_integer()];
+arg_types(hipe_bifs, alloc_loader_state, 1) ->
+ [t_atom()];
+
+%%------- lists ---------------------------------------------------------------
+arg_types(lists, all, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, any, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, append, 2) ->
+ arg_types(erlang, '++', 2); % alias
+arg_types(lists, delete, 2) ->
+ [t_any(), t_maybe_improper_list()];
+arg_types(lists, dropwhile, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, filter, 2) ->
+ [t_fun([t_any()], t_boolean()), t_list()];
+arg_types(lists, flatten, 1) ->
+ [t_list()];
+arg_types(lists, flatmap, 2) ->
+ [t_fun([t_any()], t_list()), t_list()];
+arg_types(lists, foreach, 2) ->
+ [t_fun([t_any()], t_any()), t_list()];
+arg_types(lists, foldl, 3) ->
+ [t_fun([t_any(), t_any()], t_any()), t_any(), t_list()];
+arg_types(lists, foldr, 3) ->
+ arg_types(lists, foldl, 3); % same
+arg_types(lists, keydelete, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple())];
+arg_types(lists, keyfind, 3) ->
+ arg_types(lists, keysearch, 3);
+arg_types(lists, keymap, 3) ->
+ [t_fun([t_any()], t_any()), t_pos_fixnum(), t_list(t_tuple())];
+arg_types(lists, keymember, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple());
+arg_types(lists, keymerge, 3) ->
+ [t_pos_fixnum(), t_list(t_tuple()), t_list(t_tuple())];
+arg_types(lists, keyreplace, 4) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list(), t_tuple()]; % t_list(t_tuple())];
+arg_types(lists, keysearch, 3) ->
+ [t_any(), t_pos_fixnum(), t_maybe_improper_list()]; % t_list(t_tuple())];
+arg_types(lists, keysort, 2) ->
+ [t_pos_fixnum(), t_list(t_tuple())];
+arg_types(lists, last, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, map, 2) ->
+ [t_fun([t_any()], t_any()), t_list()];
+arg_types(lists, mapfoldl, 3) ->
+ [t_fun([t_any(), t_any()], t_tuple([t_any(), t_any()])), t_any(), t_list()];
+arg_types(lists, mapfoldr, 3) ->
+ arg_types(lists, mapfoldl, 3); % same
+arg_types(lists, max, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, member, 2) ->
+ [t_any(), t_list()];
+%% arg_types(lists, merge, 1) ->
+%% [t_list(t_list())];
+arg_types(lists, merge, 2) ->
+ [t_list(), t_list()];
+%% arg_types(lists, merge, 3) ->
+%% [t_fun([t_any(), t_any()], t_boolean()), t_list(), t_list()];
+%% arg_types(lists, merge3, 3) ->
+%% [t_list(), t_list(), t_list()];
+arg_types(lists, min, 1) ->
+ [t_nonempty_list()];
+arg_types(lists, nth, 2) ->
+ [t_pos_fixnum(), t_nonempty_list()];
+arg_types(lists, nthtail, 2) ->
+ [t_non_neg_fixnum(), t_nonempty_list()];
+arg_types(lists, partition, 2) ->
+ arg_types(lists, filter, 2); % same
+arg_types(lists, reverse, 1) ->
+ [t_list()];
+arg_types(lists, reverse, 2) ->
+ [t_list(), t_any()];
+arg_types(lists, sort, 1) ->
+ [t_list()];
+arg_types(lists, sort, 2) ->
+ [t_fun([t_any(), t_any()], t_boolean()), t_list()];
+arg_types(lists, split, 2) ->
+ [t_non_neg_fixnum(), t_maybe_improper_list()]; % do not lie in 2nd arg
+arg_types(lists, splitwith, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, subtract, 2) ->
+ arg_types(erlang, '--', 2); % alias
+arg_types(lists, takewhile, 2) ->
+ [t_fun([t_any()], t_boolean()), t_maybe_improper_list()];
+arg_types(lists, usort, 1) ->
+ arg_types(lists, sort, 1); % same
+arg_types(lists, usort, 2) ->
+ arg_types(lists, sort, 2);
+arg_types(lists, unzip, 1) ->
+ [t_list(t_tuple(2))];
+arg_types(lists, unzip3, 1) ->
+ [t_list(t_tuple(3))];
+arg_types(lists, zip, 2) ->
+ [t_list(), t_list()];
+arg_types(lists, zip3, 3) ->
+ [t_list(), t_list(), t_list()];
+arg_types(lists, zipwith, 3) ->
+ [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()];
+arg_types(lists, zipwith3, 4) ->
+ [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()];
+%%------- maps ----------------------------------------------------------------
+arg_types(maps, from_list, 1) ->
+ [t_list(t_tuple(2))];
+arg_types(maps, get, 2) ->
+ [t_any(), t_map()];
+arg_types(maps, is_key, 2) ->
+ [t_any(), t_map()];
+arg_types(maps, merge, 2) ->
+ [t_map(), t_map()];
+arg_types(maps, put, 3) ->
+ [t_any(), t_any(), t_map()];
+arg_types(maps, remove, 2) ->
+ [t_any(), t_map()];
+arg_types(maps, size, 1) ->
+ [t_map()];
+arg_types(maps, update, 3) ->
+ [t_any(), t_any(), t_map()];
+arg_types(M, F, A) when is_atom(M), is_atom(F),
+ is_integer(A), 0 =< A, A =< 255 ->
+ unknown. % safe approximation for all functions.
+
+
+-spec is_known(module(), atom(), arity()) -> boolean().
+
+is_known(M, F, A) ->
+ arg_types(M, F, A) =/= unknown.
+
+-spec opaque_args(module(), atom(), arity(),
+ arg_types(), opaques()) -> [pos_integer()].
+
+%% Use this function to find out which argument caused empty type.
+
+opaque_args(_M, _F, _A, _Xs, 'universe') -> [];
+opaque_args(M, F, A, Xs, Opaques) ->
+ case kind_of_check(M, F, A) of
+ record ->
+ [X,Y|_] = Xs,
+ [1 ||
+ case t_is_tuple(X, Opaques) of
+ true ->
+ case t_tuple_subtypes(X, Opaques) of
+ unknown -> false;
+ List when length(List) >= 1 ->
+ (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
+ true ->
+ case t_fun_args(Fun, Opaques) of
+ unknown ->
+ case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of
+ true -> error;
+ false -> ok
+ end;
+ FunDom when length(FunDom) =:= length(Args) ->
+ case any_is_none_or_unit(inf_lists(FunDom, Args, Opaques)) of
+ true -> error;
+ false ->
+ case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of
+ true -> error;
+ false -> ok
+ end
+ end;
+ _ -> error
+ end;
+ false ->
+ error
+ end.
+
+
+%% =====================================================================
+%% Some basic types used in various parts of the system
+%% =====================================================================
+
+t_endian() ->
+ t_sup(t_atom('big'), t_atom('little')).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'erlang'
+%% =====================================================================
+
+t_crc32() ->
+ t_non_neg_integer().
+
+t_sequential_tracer() ->
+ t_sup([t_atom('false'), t_pid(), t_port()]).
+
+t_system_cpu_topology() ->
+ t_sup(t_atom('undefined'), t_system_cpu_topology_level_entry_list()).
+
+t_system_cpu_topology_level_entry_list() ->
+ t_list(t_system_cpu_topology_level_entry()).
+
+t_system_cpu_topology_level_entry() ->
+ t_sup(t_tuple([t_system_cpu_topology_level_tag(),
+ t_system_cpu_topology_sublevel_entry()]),
+ t_tuple([t_system_cpu_topology_level_tag(),
+ t_system_cpu_topology_info_list(),
+ t_system_cpu_topology_sublevel_entry()])).
+
+t_system_cpu_topology_sublevel_entry() ->
+ t_sup(t_system_cpu_topology_logical_cpu_id(),
+ t_list(t_tuple())). % approximation
+
+t_system_cpu_topology_level_tag() ->
+ t_atoms(['core', 'node', 'processor', 'thread']).
+
+t_system_cpu_topology_logical_cpu_id() ->
+ t_tuple([t_atom('logical'), t_non_neg_fixnum()]).
+
+t_system_cpu_topology_info_list() ->
+ t_nil(). % it may be extended in the future
+
+t_internal_cpu_topology() -> %% Internal undocumented type
+ t_sup(t_list(t_tuple([t_atom('cpu'),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum(),
+ t_non_neg_fixnum()])),
+ t_atom('undefined')).
+
+t_scheduler_bind_type_results() ->
+ t_sup([t_atom('no_node_processor_spread'),
+ t_atom('no_node_thread_spread'),
+ t_atom('no_spread'),
+ t_atom('processor_spread'),
+ t_atom('spread'),
+ t_atom('thread_spread'),
+ t_atom('thread_no_node_processor_spread'),
+ t_atom('unbound')]).
+
+t_system_multi_scheduling() ->
+ t_sup([t_atom('blocked'), t_atom('disabled'), t_atom('enabled')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'hipe_bifs'
+%% =====================================================================
+
+t_trampoline() ->
+ t_sup(t_nil(), t_integer()).
+
+t_immediate() ->
+ t_sup([t_nil(), t_atom(), t_fixnum()]).
+
+t_immarray() ->
+ t_integer(). %% abstract data type
+
+t_hiperef() ->
+ t_immarray().
+
+t_bitarray() ->
+ t_bitstr().
+
+t_bytearray() ->
+ t_binary().
+
+t_insn_type() ->
+ t_sup([% t_atom('call'),
+ t_atom('load_mfa'),
+ t_atom('x86_abs_pcrel'),
+ t_atom('atom'),
+ t_atom('constant'),
+ t_atom('c_const'),
+ t_atom('closure')]).
+
+%% =====================================================================
+%% Some testing code for ranges below
+%% =====================================================================
+
+-ifdef(DO_ERL_BIF_TYPES_TEST).
+
+test() ->
+ put(hipe_target_arch, amd64),
+
+ Bsl1 = type(erlang, 'bsl', 2, [t_from_range(1, 299), t_from_range(-4, 22)]),
+ Bsl2 = type(erlang, 'bsl', 2),
+ Bsl3 = type(erlang, 'bsl', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("Bsl ~p ~p ~p~n", [Bsl1, Bsl2, Bsl3]),
+
+ Add1 = type(erlang, '+', 2, [t_from_range(1, 299), t_from_range(-4, 22)]),
+ Add2 = type(erlang, '+', 2),
+ Add3 = type(erlang, '+', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("Add ~p ~p ~p~n", [Add1, Add2, Add3]),
+
+ Band1 = type(erlang, 'band', 2, [t_from_range(1, 29), t_from_range(34, 36)]),
+ Band2 = type(erlang, 'band', 2),
+ Band3 = type(erlang, 'band', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("band ~p ~p ~p~n", [Band1, Band2, Band3]),
+
+ Bor1 = type(erlang, 'bor', 2, [t_from_range(1, 29), t_from_range(8, 11)]),
+ Bor2 = type(erlang, 'bor', 2),
+ Bor3 = type(erlang, 'bor', 2, [t_from_range(1, 299), t_atom('pelle')]),
+ io:format("bor ~p ~p ~p~n", [Bor1, Bor2, Bor3]),
+
+ io:format("inf_?"),
+ pos_inf = infinity_max([1, 4, 51, pos_inf]),
+ -12 = infinity_min([1, 142, -4, -12]),
+ neg_inf = infinity_max([neg_inf]),
+
+ io:format("width"),
+ 4 = width({7, 9}),
+ pos_inf = width({neg_inf, 100}),
+ pos_inf = width({1, pos_inf}),
+ 3 = width({-8, 7}),
+ 0 = width({-1, 0}),
+
+ io:format("arith * "),
+ Mult1 = t_from_range(0, 12),
+ Mult2 = t_from_range(-21, 7),
+ Mult1 = type(erlang, '*', 2, [t_from_range(2,3), t_from_range(0,4)]),
+ Mult2 = type(erlang, '*', 2, [t_from_range(-7,-1), t_from_range(-1,3)]),
+ ok.
+
+-endif.
diff --git a/lib/dialyzer/src/erl_types.erl b/lib/dialyzer/src/erl_types.erl
new file mode 100644
index 0000000000..9526a2a10d
--- /dev/null
+++ b/lib/dialyzer/src/erl_types.erl
@@ -0,0 +1,5731 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% @copyright 2000-2003 Richard Carlsson, 2006-2009 Tobias Lindahl
+%% @author Richard Carlsson <carlsson.richard@gmail.com>
+%% @author Tobias Lindahl <tobias.lindahl@gmail.com>
+%% @author Kostis Sagonas <kostis@cs.ntua.gr>
+%% @author Manouk Manoukian
+%% @doc Provides a representation of Erlang types.
+
+%% The initial author of this file is Richard Carlsson (2000-2004).
+%% In July 2006, the type representation was totally re-designed by
+%% Tobias Lindahl. This is the representation which is used currently.
+%% In late 2008, Manouk Manoukian and Kostis Sagonas added support for
+%% opaque types to the structure-based representation of types.
+%% During February and March 2009, Kostis Sagonas significantly
+%% cleaned up the type representation and added spec declarations.
+
+-module(erl_types).
+
+-export([any_none/1,
+ any_none_or_unit/1,
+ lookup_record/3,
+ max/2,
+ min/2,
+ number_max/1, number_max/2,
+ number_min/1, number_min/2,
+ t_abstract_records/2,
+ t_any/0,
+ t_arity/0,
+ t_atom/0,
+ t_atom/1,
+ t_atoms/1,
+ t_atom_vals/1, t_atom_vals/2,
+ t_binary/0,
+ t_bitstr/0,
+ t_bitstr/2,
+ t_bitstr_base/1,
+ t_bitstr_concat/1,
+ t_bitstr_concat/2,
+ t_bitstr_match/2,
+ t_bitstr_unit/1,
+ t_bitstrlist/0,
+ t_boolean/0,
+ t_byte/0,
+ t_char/0,
+ t_collect_vars/1,
+ t_cons/0,
+ t_cons/2,
+ t_cons_hd/1, t_cons_hd/2,
+ t_cons_tl/1, t_cons_tl/2,
+ t_contains_opaque/1, t_contains_opaque/2,
+ t_decorate_with_opaque/3,
+ t_elements/1,
+ t_find_opaque_mismatch/3,
+ t_find_unknown_opaque/3,
+ t_fixnum/0,
+ t_non_neg_fixnum/0,
+ t_pos_fixnum/0,
+ t_float/0,
+ t_var_names/1,
+ t_form_to_string/1,
+ t_from_form/6,
+ t_from_form_without_remote/3,
+ t_from_form_check_remote/4,
+ t_check_record_fields/6,
+ t_from_range/2,
+ t_from_range_unsafe/2,
+ t_from_term/1,
+ t_fun/0,
+ t_fun/1,
+ t_fun/2,
+ t_fun_args/1, t_fun_args/2,
+ t_fun_arity/1, t_fun_arity/2,
+ t_fun_range/1, t_fun_range/2,
+ t_has_opaque_subtype/2,
+ t_has_var/1,
+ t_identifier/0,
+ %% t_improper_list/2,
+ t_inf/1,
+ t_inf/2,
+ t_inf/3,
+ t_inf_lists/2,
+ t_inf_lists/3,
+ t_integer/0,
+ t_integer/1,
+ t_non_neg_integer/0,
+ t_pos_integer/0,
+ t_integers/1,
+ t_iodata/0,
+ t_iolist/0,
+ t_is_any/1,
+ t_is_atom/1, t_is_atom/2,
+ t_is_any_atom/2, t_is_any_atom/3,
+ t_is_binary/1, t_is_binary/2,
+ t_is_bitstr/1, t_is_bitstr/2,
+ t_is_bitwidth/1,
+ t_is_boolean/1, t_is_boolean/2,
+ t_is_byte/1,
+ t_is_char/1,
+ t_is_cons/1, t_is_cons/2,
+ t_is_equal/2,
+ t_is_fixnum/1,
+ t_is_float/1, t_is_float/2,
+ t_is_fun/1, t_is_fun/2,
+ t_is_identifier/1,
+ t_is_instance/2,
+ t_is_integer/1, t_is_integer/2,
+ t_is_list/1,
+ t_is_map/1,
+ t_is_map/2,
+ t_is_matchstate/1,
+ t_is_nil/1, t_is_nil/2,
+ t_is_non_neg_integer/1,
+ t_is_none/1,
+ t_is_none_or_unit/1,
+ t_is_number/1, t_is_number/2,
+ t_is_opaque/1, t_is_opaque/2,
+ t_is_pid/1, t_is_pid/2,
+ t_is_port/1, t_is_port/2,
+ t_is_maybe_improper_list/1, t_is_maybe_improper_list/2,
+ t_is_reference/1, t_is_reference/2,
+ t_is_singleton/1,
+ t_is_singleton/2,
+ t_is_string/1,
+ t_is_subtype/2,
+ t_is_tuple/1, t_is_tuple/2,
+ t_is_unit/1,
+ t_is_var/1,
+ t_limit/2,
+ t_list/0,
+ t_list/1,
+ t_list_elements/1, t_list_elements/2,
+ t_list_termination/1, t_list_termination/2,
+ t_map/0,
+ t_map/1,
+ t_map/3,
+ t_map_entries/2, t_map_entries/1,
+ t_map_def_key/2, t_map_def_key/1,
+ t_map_def_val/2, t_map_def_val/1,
+ t_map_get/2, t_map_get/3,
+ t_map_is_key/2, t_map_is_key/3,
+ t_map_update/2, t_map_update/3,
+ t_map_pairwise_merge/4,
+ t_map_put/2, t_map_put/3,
+ t_map_remove/3,
+ t_matchstate/0,
+ t_matchstate/2,
+ t_matchstate_present/1,
+ t_matchstate_slot/2,
+ t_matchstate_slots/1,
+ t_matchstate_update_present/2,
+ t_matchstate_update_slot/3,
+ t_mfa/0,
+ t_module/0,
+ t_nil/0,
+ t_node/0,
+ t_none/0,
+ t_nonempty_list/0,
+ t_nonempty_list/1,
+ t_nonempty_string/0,
+ t_number/0,
+ t_number/1,
+ t_number_vals/1, t_number_vals/2,
+ t_opaque_from_records/1,
+ t_opaque_structure/1,
+ t_pid/0,
+ t_port/0,
+ t_maybe_improper_list/0,
+ %% t_maybe_improper_list/2,
+ t_product/1,
+ t_reference/0,
+ t_singleton_to_term/2,
+ t_string/0,
+ t_struct_from_opaque/2,
+ t_subst/2,
+ t_subtract/2,
+ t_subtract_list/2,
+ t_sup/1,
+ t_sup/2,
+ t_timeout/0,
+ t_to_string/1,
+ t_to_string/2,
+ t_to_tlist/1,
+ t_tuple/0,
+ t_tuple/1,
+ t_tuple_args/1, t_tuple_args/2,
+ t_tuple_size/1, t_tuple_size/2,
+ t_tuple_sizes/1,
+ t_tuple_subtypes/1,
+ t_tuple_subtypes/2,
+ t_unify/2,
+ t_unit/0,
+ t_unopaque/1, t_unopaque/2,
+ t_var/1,
+ t_var_name/1,
+ t_widen_to_number/1,
+ %% t_assign_variables_to_subtype/2,
+ type_is_defined/4,
+ record_field_diffs_to_string/2,
+ subst_all_vars_to_any/1,
+ lift_list_to_pos_empty/1, lift_list_to_pos_empty/2,
+ is_opaque_type/2,
+ is_erl_type/1,
+ atom_to_string/1,
+ var_table__new/0,
+ cache__new/0
+ ]).
+
+-compile({no_auto_import,[min/2,max/2,map_get/2]}).
+
+-export_type([erl_type/0, opaques/0, type_table/0,
+ var_table/0, cache/0]).
+
+%%-define(DEBUG, true).
+
+-ifdef(DEBUG).
+-define(debug(__A), __A).
+-else.
+-define(debug(__A), ok).
+-endif.
+
+%%=============================================================================
+%%
+%% Definition of the type structure
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Limits
+%%
+
+-define(REC_TYPE_LIMIT, 2).
+-define(EXPAND_DEPTH, 16).
+-define(EXPAND_LIMIT, 10000).
+
+-define(TUPLE_TAG_LIMIT, 5).
+-define(TUPLE_ARITY_LIMIT, 8).
+-define(SET_LIMIT, 13).
+-define(MAX_BYTE, 255).
+-define(MAX_CHAR, 16#10ffff).
+
+-define(UNIT_MULTIPLIER, 8).
+
+-define(TAG_IMMED1_SIZE, 4).
+-define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE).
+
+-define(MAX_TUPLE_SIZE, (1 bsl 10)).
+
+%%-----------------------------------------------------------------------------
+%% Type tags and qualifiers
+%%
+
+-define(atom_tag, atom).
+-define(binary_tag, binary).
+-define(function_tag, function).
+-define(identifier_tag, identifier).
+-define(list_tag, list).
+-define(map_tag, map).
+-define(matchstate_tag, matchstate).
+-define(nil_tag, nil).
+-define(number_tag, number).
+-define(opaque_tag, opaque).
+-define(product_tag, product).
+-define(tuple_set_tag, tuple_set).
+-define(tuple_tag, tuple).
+-define(union_tag, union).
+-define(var_tag, var).
+
+-type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag
+ | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag
+ | ?opaque_tag | ?product_tag
+ | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag.
+
+-define(float_qual, float).
+-define(integer_qual, integer).
+-define(nonempty_qual, nonempty).
+-define(pid_qual, pid).
+-define(port_qual, port).
+-define(reference_qual, reference).
+-define(unknown_qual, unknown).
+
+-type qual() :: ?float_qual | ?integer_qual | ?nonempty_qual | ?pid_qual
+ | ?port_qual | ?reference_qual | ?unknown_qual | {_, _}.
+
+%%-----------------------------------------------------------------------------
+%% The type representation
+%%
+
+-define(any, any).
+-define(none, none).
+-define(unit, unit).
+%% Generic constructor - elements can be many things depending on the tag.
+-record(c, {tag :: tag(),
+ elements = [] :: term(),
+ qualifier = ?unknown_qual :: qual()}).
+
+-opaque erl_type() :: ?any | ?none | ?unit | #c{}.
+
+%%-----------------------------------------------------------------------------
+%% Auxiliary types and convenient macros
+%%
+
+-type parse_form() :: erl_parse:abstract_type().
+-type rng_elem() :: 'pos_inf' | 'neg_inf' | integer().
+
+-record(int_set, {set :: [integer()]}).
+-record(int_rng, {from :: rng_elem(), to :: rng_elem()}).
+%% Note: the definition of #opaque{} was changed to 'mod' and 'name';
+%% it used to be an ordsets of {Mod, Name} pairs. The Dialyzer version
+%% was updated to 2.7 due to this change.
+-record(opaque, {mod :: module(), name :: atom(),
+ args = [] :: [erl_type()], struct :: erl_type()}).
+
+-define(atom(Set), #c{tag=?atom_tag, elements=Set}).
+-define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}).
+-define(float, ?number(?any, ?float_qual)).
+-define(function(Domain, Range), #c{tag=?function_tag,
+ elements=[Domain, Range]}).
+-define(identifier(Types), #c{tag=?identifier_tag, elements=Types}).
+-define(integer(Types), ?number(Types, ?integer_qual)).
+-define(int_range(From, To), ?integer(#int_rng{from=From, to=To})).
+-define(int_set(Set), ?integer(#int_set{set=Set})).
+-define(list(Types, Term, Size), #c{tag=?list_tag, elements=[Types,Term],
+ qualifier=Size}).
+-define(nil, #c{tag=?nil_tag}).
+-define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)).
+-define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set,
+ qualifier=Qualifier}).
+-define(map(Pairs,DefKey,DefVal),
+ #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}).
+-define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}).
+-define(product(Types), #c{tag=?product_tag, elements=Types}).
+-define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types,
+ qualifier={Arity, Qual}}).
+-define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}).
+-define(var(Id), #c{tag=?var_tag, elements=Id}).
+
+-define(matchstate(P, Slots), #c{tag=?matchstate_tag, elements=[P,Slots]}).
+-define(any_matchstate, ?matchstate(t_bitstr(), ?any)).
+
+-define(byte, ?int_range(0, ?MAX_BYTE)).
+-define(char, ?int_range(0, ?MAX_CHAR)).
+-define(integer_pos, ?int_range(1, pos_inf)).
+-define(integer_non_neg, ?int_range(0, pos_inf)).
+-define(integer_neg, ?int_range(neg_inf, -1)).
+
+-type opaques() :: [erl_type()] | 'universe'.
+
+-type file_line() :: {file:name(), erl_anno:line()}.
+-type record_key() :: {'record', atom()}.
+-type type_key() :: {'type' | 'opaque', mfa()}.
+-type field() :: {atom(), erl_parse:abstract_expr(), erl_type()}.
+-type record_value() :: {file_line(),
+ [{RecordSize :: non_neg_integer(), [field()]}]}.
+-type type_value() :: {{module(), file_line(),
+ erl_parse:abstract_type(), ArgNames :: [atom()]},
+ erl_type()}.
+-type type_table() :: #{record_key() | type_key() =>
+ record_value() | type_value()}.
+
+-opaque var_table() :: #{atom() => erl_type()}.
+
+%%-----------------------------------------------------------------------------
+%% Unions
+%%
+
+-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}).
+
+-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])).
+-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])).
+-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])).
+-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])).
+-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])).
+-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])).
+-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])).
+-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])).
+-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])).
+-define(integer_union(T), ?number_union(T)).
+-define(float_union(T), ?number_union(T)).
+-define(nil_union(T), ?list_union(T)).
+
+
+%%=============================================================================
+%%
+%% Primitive operations such as type construction and type tests
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Top and bottom
+%%
+
+-spec t_any() -> erl_type().
+
+t_any() ->
+ ?any.
+
+-spec t_is_any(erl_type()) -> boolean().
+
+t_is_any(Type) ->
+ do_opaque(Type, 'universe', fun is_any/1).
+
+is_any(?any) -> true;
+is_any(_) -> false.
+
+-spec t_none() -> erl_type().
+
+t_none() ->
+ ?none.
+
+-spec t_is_none(erl_type()) -> boolean().
+
+t_is_none(?none) -> true;
+t_is_none(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Opaque types
+%%
+
+-spec t_opaque(module(), atom(), [_], erl_type()) -> erl_type().
+
+t_opaque(Mod, Name, Args, Struct) ->
+ O = #opaque{mod = Mod, name = Name, args = Args, struct = Struct},
+ ?opaque(set_singleton(O)).
+
+-spec t_is_opaque(erl_type(), [erl_type()]) -> boolean().
+
+t_is_opaque(?opaque(_) = Type, Opaques) ->
+ not is_opaque_type(Type, Opaques);
+t_is_opaque(_Type, _Opaques) -> false.
+
+-spec t_is_opaque(erl_type()) -> boolean().
+
+t_is_opaque(?opaque(_)) -> true;
+t_is_opaque(_) -> false.
+
+-spec t_has_opaque_subtype(erl_type(), opaques()) -> boolean().
+
+t_has_opaque_subtype(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun has_opaque_subtype/1).
+
+has_opaque_subtype(?union(Ts)) ->
+ lists:any(fun t_is_opaque/1, Ts);
+has_opaque_subtype(T) ->
+ t_is_opaque(T).
+
+-spec t_opaque_structure(erl_type()) -> erl_type().
+
+t_opaque_structure(?opaque(Elements)) ->
+ t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]).
+
+-spec t_contains_opaque(erl_type()) -> boolean().
+
+t_contains_opaque(Type) ->
+ t_contains_opaque(Type, []).
+
+%% Returns 'true' iff there is an opaque type that is *not* one of
+%% the types of the second argument.
+
+-spec t_contains_opaque(erl_type(), [erl_type()]) -> boolean().
+
+t_contains_opaque(?any, _Opaques) -> false;
+t_contains_opaque(?none, _Opaques) -> false;
+t_contains_opaque(?unit, _Opaques) -> false;
+t_contains_opaque(?atom(_Set), _Opaques) -> false;
+t_contains_opaque(?bitstr(_Unit, _Base), _Opaques) -> false;
+t_contains_opaque(?float, _Opaques) -> false;
+t_contains_opaque(?function(Domain, Range), Opaques) ->
+ t_contains_opaque(Domain, Opaques)
+ orelse t_contains_opaque(Range, Opaques);
+t_contains_opaque(?identifier(_Types), _Opaques) -> false;
+t_contains_opaque(?int_range(_From, _To), _Opaques) -> false;
+t_contains_opaque(?int_set(_Set), _Opaques) -> false;
+t_contains_opaque(?integer(_Types), _Opaques) -> false;
+t_contains_opaque(?list(Type, Tail, _), Opaques) ->
+ t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques);
+t_contains_opaque(?map(_, _, _) = Map, Opaques) ->
+ list_contains_opaque(map_all_types(Map), Opaques);
+t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false;
+t_contains_opaque(?nil, _Opaques) -> false;
+t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false;
+t_contains_opaque(?opaque(_)=T, Opaques) ->
+ not is_opaque_type(T, Opaques)
+ orelse t_contains_opaque(t_opaque_structure(T));
+t_contains_opaque(?product(Types), Opaques) ->
+ list_contains_opaque(Types, Opaques);
+t_contains_opaque(?tuple(?any, _, _), _Opaques) -> false;
+t_contains_opaque(?tuple(Types, _, _), Opaques) ->
+ list_contains_opaque(Types, Opaques);
+t_contains_opaque(?tuple_set(_Set) = T, Opaques) ->
+ list_contains_opaque(t_tuple_subtypes(T), Opaques);
+t_contains_opaque(?union(List), Opaques) ->
+ list_contains_opaque(List, Opaques);
+t_contains_opaque(?var(_Id), _Opaques) -> false.
+
+-spec list_contains_opaque([erl_type()], [erl_type()]) -> boolean().
+
+list_contains_opaque(List, Opaques) ->
+ lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List).
+
+%% t_find_opaque_mismatch/2 of two types should only be used if their
+%% t_inf is t_none() due to some opaque type violation. However,
+%% 'error' is returned if a structure mismatch is found.
+%%
+%% The first argument of the function is the pattern and its second
+%% argument the type we are matching against the pattern.
+
+-spec t_find_opaque_mismatch(erl_type(), erl_type(), [erl_type()]) ->
+ 'error' | {'ok', erl_type(), erl_type()}.
+
+t_find_opaque_mismatch(T1, T2, Opaques) ->
+ try t_find_opaque_mismatch(T1, T2, T2, Opaques)
+ catch throw:error -> error
+ end.
+
+t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error;
+t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error);
+t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) ->
+ t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques);
+t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) ->
+ case is_opaque_type(T2, Opaques) of
+ false ->
+ case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T2}
+ end;
+ true ->
+ t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques)
+ end;
+t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) ->
+ %% The generated message is somewhat misleading:
+ case is_opaque_type(T1, Opaques) of
+ false ->
+ case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of
+ true -> error;
+ false -> {ok, TopType, T1}
+ end;
+ true ->
+ t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques)
+ end;
+t_find_opaque_mismatch(?product(T1), ?product(T2), TopType, Opaques) ->
+ t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques);
+t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _),
+ TopType, Opaques) ->
+ t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques);
+t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2,
+ TopType, Opaques) ->
+ Tuples1 = t_tuple_subtypes(T1),
+ Tuples2 = t_tuple_subtypes(T2),
+ t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques);
+t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) ->
+ t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques);
+t_find_opaque_mismatch(T1, T2, _TopType, Opaques) ->
+ case t_is_none(t_inf(T1, T2, Opaques)) of
+ false -> error;
+ true -> throw(error)
+ end.
+
+t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) ->
+ List = lists:zipwith(fun(T1, T2) ->
+ t_find_opaque_mismatch(T1, T2, TopType, Opaques)
+ end, L1, L2),
+ t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) ->
+ List = [try t_find_opaque_mismatch(T1, T2, T2, Opaques)
+ catch throw:error -> error
+ end || T1 <- L1, T2 <- L2],
+ t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_list([]) -> throw(error);
+t_find_opaque_mismatch_list([H|T]) ->
+ case H of
+ {ok, _T1, _T2} -> H;
+ error -> t_find_opaque_mismatch_list(T)
+ end.
+
+-spec t_find_unknown_opaque(erl_type(), erl_type(), opaques()) ->
+ [pos_integer()].
+
+%% The nice thing about using two types and t_inf() as compared to
+%% calling t_contains_opaque/2 is that the traversal stops when
+%% there is a mismatch which means that unknown opaque types "below"
+%% the mismatch are not found.
+t_find_unknown_opaque(_T1, _T2, 'universe') -> [];
+t_find_unknown_opaque(T1, T2, Opaques) ->
+ try t_inf(T1, T2, {match, Opaques}) of
+ _ -> []
+ catch throw:{pos, Ns} -> Ns
+ end.
+
+-spec t_decorate_with_opaque(erl_type(), erl_type(), [erl_type()]) -> erl_type().
+
+%% The first argument can contain opaque types. The second argument
+%% is assumed to be taken from the contract.
+
+t_decorate_with_opaque(T1, T2, Opaques) ->
+ case
+ Opaques =:= [] orelse t_is_equal(T1, T2) orelse not t_contains_opaque(T2)
+ of
+ true -> T1;
+ false ->
+ T = t_inf(T1, T2),
+ case t_contains_opaque(T) of
+ false -> T1;
+ true ->
+ R = decorate(T1, T, Opaques),
+ ?debug(case catch
+ not t_is_equal(t_unopaque(R), t_unopaque(T1))
+ orelse
+ t_is_equal(T1, T) andalso not t_is_equal(T1, R)
+ of
+ false -> ok;
+ _ ->
+ io:format("T1 = ~p,\n", [T1]),
+ io:format("T2 = ~p,\n", [T2]),
+ io:format("O = ~p,\n", [Opaques]),
+ io:format("erl_types:t_decorate_with_opaque(T1,T2,O).\n"),
+ throw({error, "Failed to handle opaque types"})
+ end),
+ R
+ end
+ end.
+
+decorate(Type, ?none, _Opaques) -> Type;
+decorate(?function(Domain, Range), ?function(D, R), Opaques) ->
+ ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques));
+decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) ->
+ ?list(decorate(Types, Ts, Opaques), decorate(Tail, Tl, Opaques), Size);
+decorate(?product(Types), ?product(Ts), Opaques) ->
+ ?product(list_decorate(Types, Ts, Opaques));
+decorate(?tuple(_, _, _)=T, ?tuple(?any, _, _), _Opaques) -> T;
+decorate(?tuple(?any, _, _)=T, ?tuple(_, _, _), _Opaques) -> T;
+decorate(?tuple(Types, Arity, Tag), ?tuple(Ts, Arity, _), Opaques) ->
+ ?tuple(list_decorate(Types, Ts, Opaques), Arity, Tag);
+decorate(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) ->
+ decorate_tuple_sets(List, [{Arity, [T]}], Opaques);
+decorate(?tuple_set(List), ?tuple_set(L), Opaques) ->
+ decorate_tuple_sets(List, L, Opaques);
+decorate(?union(List), T, Opaques) when T =/= ?any ->
+ ?union(L) = force_union(T),
+ union_decorate(List, L, Opaques);
+decorate(T, ?union(L), Opaques) when T =/= ?any ->
+ ?union(List) = force_union(T),
+ union_decorate(List, L, Opaques);
+decorate(Type, ?opaque(_)=T, Opaques) ->
+ decorate_with_opaque(Type, T, Opaques);
+decorate(Type, _T, _Opaques) -> Type.
+
+%% Note: it is important that #opaque.struct is a subtype of the
+%% opaque type.
+decorate_with_opaque(Type, ?opaque(Set2), Opaques) ->
+ case decoration(set_to_list(Set2), Type, Opaques, [], false) of
+ {[], false} -> Type;
+ {List, All} when List =/= [] ->
+ NewType = sup_opaque(List),
+ case All of
+ true -> NewType;
+ false -> t_sup(NewType, Type)
+ end
+ end.
+
+decoration([#opaque{struct = S} = Opaque|OpaqueTypes], Type, Opaques,
+ NewOpaqueTypes0, All) ->
+ IsOpaque = is_opaque_type2(Opaque, Opaques),
+ I = t_inf(Type, S),
+ case not IsOpaque orelse t_is_none(I) of
+ true -> decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes0, All);
+ false ->
+ NewI = decorate(I, S, Opaques),
+ NewOpaque = combine(NewI, [Opaque]),
+ NewAll = All orelse t_is_equal(I, Type),
+ NewOpaqueTypes = NewOpaque ++ NewOpaqueTypes0,
+ decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes, NewAll)
+ end;
+decoration([], _Type, _Opaques, NewOpaqueTypes, All) ->
+ {NewOpaqueTypes, All}.
+
+-spec list_decorate([erl_type()], [erl_type()], opaques()) -> [erl_type()].
+
+list_decorate(List, L, Opaques) ->
+ [decorate(Elem, E, Opaques) || {Elem, E} <- lists:zip(List, L)].
+
+union_decorate(U1, U2, Opaques) ->
+ Union = union_decorate(U1, U2, Opaques, 0, []),
+ [A,B,F,I,L,N,T,M,_,Map] = U1,
+ [_,_,_,_,_,_,_,_,Opaque,_] = U2,
+ List = [A,B,F,I,L,N,T,M,Map],
+ DecList = [Dec ||
+ E <- List,
+ not t_is_none(E),
+ not t_is_none(Dec = decorate(E, Opaque, Opaques))],
+ t_sup([Union|DecList]).
+
+union_decorate([?none|Left1], [_|Left2], Opaques, N, Acc) ->
+ union_decorate(Left1, Left2, Opaques, N, [?none|Acc]);
+union_decorate([T1|Left1], [?none|Left2], Opaques, N, Acc) ->
+ union_decorate(Left1, Left2, Opaques, N+1, [T1|Acc]);
+union_decorate([T1|Left1], [T2|Left2], Opaques, N, Acc) ->
+ union_decorate(Left1, Left2, Opaques, N+1, [decorate(T1, T2, Opaques)|Acc]);
+union_decorate([], [], _Opaques, N, Acc) ->
+ if N =:= 0 -> ?none;
+ N =:= 1 ->
+ [Type] = [T || T <- Acc, T =/= ?none],
+ Type;
+ N >= 2 -> ?union(lists:reverse(Acc))
+ end.
+
+decorate_tuple_sets(List, L, Opaques) ->
+ decorate_tuple_sets(List, L, Opaques, []).
+
+decorate_tuple_sets([{Arity, Tuples}|List], [{Arity, Ts}|L], Opaques, Acc) ->
+ DecTs = decorate_tuples_in_sets(Tuples, Ts, Opaques),
+ decorate_tuple_sets(List, L, Opaques, [{Arity, DecTs}|Acc]);
+decorate_tuple_sets([ArTup|List], L, Opaques, Acc) ->
+ decorate_tuple_sets(List, L, Opaques, [ArTup|Acc]);
+decorate_tuple_sets([], _L, _Opaques, Acc) ->
+ ?tuple_set(lists:reverse(Acc)).
+
+decorate_tuples_in_sets([?tuple(Elements, _, ?any)], Ts, Opaques) ->
+ NewList = [list_decorate(Elements, Es, Opaques) || ?tuple(Es, _, _) <- Ts],
+ case t_sup([t_tuple(Es) || Es <- NewList]) of
+ ?tuple_set([{_Arity, Tuples}]) -> Tuples;
+ ?tuple(_, _, _)=Tuple -> [Tuple]
+ end;
+decorate_tuples_in_sets(Tuples, Ts, Opaques) ->
+ decorate_tuples_in_sets(Tuples, Ts, Opaques, []).
+
+decorate_tuples_in_sets([?tuple(Elements, Arity, Tag1) = T1|Tuples] = L1,
+ [?tuple(Es, Arity, Tag2)|Ts] = L2, Opaques, Acc) ->
+ if
+ Tag1 < Tag2 -> decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]);
+ Tag1 > Tag2 -> decorate_tuples_in_sets(L1, Ts, Opaques, Acc);
+ Tag1 =:= Tag2 ->
+ NewElements = list_decorate(Elements, Es, Opaques),
+ NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc],
+ decorate_tuples_in_sets(Tuples, Ts, Opaques, NewAcc)
+ end;
+decorate_tuples_in_sets([T1|Tuples], L2, Opaques, Acc) ->
+ decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]);
+decorate_tuples_in_sets([], _L, _Opaques, Acc) ->
+ lists:reverse(Acc).
+
+-spec t_opaque_from_records(type_table()) -> [erl_type()].
+
+t_opaque_from_records(RecMap) ->
+ OpaqueRecMap =
+ maps:filter(fun(Key, _Value) ->
+ case Key of
+ {opaque, _Name, _Arity} -> true;
+ _ -> false
+ end
+ end, RecMap),
+ OpaqueTypeMap =
+ maps:map(fun({opaque, Name, _Arity},
+ {{Module, _FileLine, _Form, ArgNames}, _Type}) ->
+ %% Args = args_to_types(ArgNames),
+ %% List = lists:zip(ArgNames, Args),
+ %% TmpVarTab = maps:to_list(List),
+ %% Rep = t_from_form(Type, RecDict, TmpVarTab),
+ Rep = t_any(), % not used for anything right now
+ Args = [t_any() || _ <- ArgNames],
+ t_opaque(Module, Name, Args, Rep)
+ end, OpaqueRecMap),
+ [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)].
+
+%% Decompose opaque instances of type arg2 to structured types, in arg1
+%% XXX: Same as t_unopaque
+-spec t_struct_from_opaque(erl_type(), [erl_type()]) -> erl_type().
+
+t_struct_from_opaque(?function(Domain, Range), Opaques) ->
+ ?function(t_struct_from_opaque(Domain, Opaques),
+ t_struct_from_opaque(Range, Opaques));
+t_struct_from_opaque(?list(Types, Term, Size), Opaques) ->
+ ?list(t_struct_from_opaque(Types, Opaques),
+ t_struct_from_opaque(Term, Opaques), Size);
+t_struct_from_opaque(?opaque(_) = T, Opaques) ->
+ case is_opaque_type(T, Opaques) of
+ true -> t_opaque_structure(T);
+ false -> T
+ end;
+t_struct_from_opaque(?product(Types), Opaques) ->
+ ?product(list_struct_from_opaque(Types, Opaques));
+t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaques) -> T;
+t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaques) ->
+ ?tuple(list_struct_from_opaque(Types, Opaques), Arity, Tag);
+t_struct_from_opaque(?tuple_set(Set), Opaques) ->
+ NewSet = [{Sz, [t_struct_from_opaque(T, Opaques) || T <- Tuples]}
+ || {Sz, Tuples} <- Set],
+ ?tuple_set(NewSet);
+t_struct_from_opaque(?union(List), Opaques) ->
+ t_sup(list_struct_from_opaque(List, Opaques));
+t_struct_from_opaque(Type, _Opaques) -> Type.
+
+list_struct_from_opaque(Types, Opaques) ->
+ [t_struct_from_opaque(Type, Opaques) || Type <- Types].
+
+%%-----------------------------------------------------------------------------
+%% Unit type. Signals non termination.
+%%
+
+-spec t_unit() -> erl_type().
+
+t_unit() ->
+ ?unit.
+
+-spec t_is_unit(erl_type()) -> boolean().
+
+t_is_unit(?unit) -> true;
+t_is_unit(_) -> false.
+
+-spec t_is_none_or_unit(erl_type()) -> boolean().
+
+t_is_none_or_unit(?none) -> true;
+t_is_none_or_unit(?unit) -> true;
+t_is_none_or_unit(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Atoms and the derived type boolean
+%%
+
+-spec t_atom() -> erl_type().
+
+t_atom() ->
+ ?atom(?any).
+
+-spec t_atom(atom()) -> erl_type().
+
+t_atom(A) when is_atom(A) ->
+ ?atom(set_singleton(A)).
+
+-spec t_atoms([atom()]) -> erl_type().
+
+t_atoms(List) when is_list(List) ->
+ t_sup([t_atom(A) || A <- List]).
+
+-spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...].
+
+t_atom_vals(Type) ->
+ t_atom_vals(Type, 'universe').
+
+-spec t_atom_vals(erl_type(), opaques()) -> 'unknown' | [atom(),...].
+
+t_atom_vals(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun atom_vals/1).
+
+atom_vals(?atom(?any)) -> unknown;
+atom_vals(?atom(Set)) -> set_to_list(Set);
+atom_vals(?opaque(_)) -> unknown;
+atom_vals(Other) ->
+ ?atom(_) = Atm = t_inf(t_atom(), Other),
+ atom_vals(Atm).
+
+-spec t_is_atom(erl_type()) -> boolean().
+
+t_is_atom(Type) ->
+ t_is_atom(Type, 'universe').
+
+-spec t_is_atom(erl_type(), opaques()) -> boolean().
+
+t_is_atom(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_atom1/1).
+
+is_atom1(?atom(_)) -> true;
+is_atom1(_) -> false.
+
+-spec t_is_any_atom(atom(), erl_type()) -> boolean().
+
+t_is_any_atom(Atom, SomeAtomsType) ->
+ t_is_any_atom(Atom, SomeAtomsType, 'universe').
+
+-spec t_is_any_atom(atom(), erl_type(), opaques()) -> boolean().
+
+t_is_any_atom(Atom, SomeAtomsType, Opaques) ->
+ do_opaque(SomeAtomsType, Opaques,
+ fun(AtomsType) -> is_any_atom(Atom, AtomsType) end).
+
+is_any_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false;
+is_any_atom(Atom, ?atom(Set)) when is_atom(Atom) ->
+ set_is_singleton(Atom, Set);
+is_any_atom(Atom, _) when is_atom(Atom) -> false.
+
+%%------------------------------------
+
+-spec t_is_boolean(erl_type()) -> boolean().
+
+t_is_boolean(Type) ->
+ t_is_boolean(Type, 'universe').
+
+-spec t_is_boolean(erl_type(), opaques()) -> boolean().
+
+t_is_boolean(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_boolean/1).
+
+-spec t_boolean() -> erl_type().
+
+t_boolean() ->
+ ?atom(set_from_list([false, true])).
+
+is_boolean(?atom(?any)) -> false;
+is_boolean(?atom(Set)) ->
+ case set_size(Set) of
+ 1 -> set_is_element(true, Set) orelse set_is_element(false, Set);
+ 2 -> set_is_element(true, Set) andalso set_is_element(false, Set);
+ N when is_integer(N), N > 2 -> false
+ end;
+is_boolean(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Binaries
+%%
+
+-spec t_binary() -> erl_type().
+
+t_binary() ->
+ ?bitstr(8, 0).
+
+-spec t_is_binary(erl_type()) -> boolean().
+
+t_is_binary(Type) ->
+ t_is_binary(Type, 'universe').
+
+-spec t_is_binary(erl_type(), opaques()) -> boolean().
+
+t_is_binary(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_binary/1).
+
+is_binary(?bitstr(U, B)) ->
+ ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0);
+is_binary(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Bitstrings
+%%
+
+-spec t_bitstr() -> erl_type().
+
+t_bitstr() ->
+ ?bitstr(1, 0).
+
+-spec t_bitstr(non_neg_integer(), non_neg_integer()) -> erl_type().
+
+t_bitstr(U, B) ->
+ NewB =
+ if
+ U =:= 0 -> B;
+ B >= (U * (?UNIT_MULTIPLIER + 1)) ->
+ (B rem U) + U * ?UNIT_MULTIPLIER;
+ true ->
+ B
+ end,
+ ?bitstr(U, NewB).
+
+-spec t_bitstr_unit(erl_type()) -> non_neg_integer().
+
+t_bitstr_unit(?bitstr(U, _)) -> U.
+
+-spec t_bitstr_base(erl_type()) -> non_neg_integer().
+
+t_bitstr_base(?bitstr(_, B)) -> B.
+
+-spec t_bitstr_concat([erl_type()]) -> erl_type().
+
+t_bitstr_concat(List) ->
+ t_bitstr_concat_1(List, t_bitstr(0, 0)).
+
+t_bitstr_concat_1([T|Left], Acc) ->
+ t_bitstr_concat_1(Left, t_bitstr_concat(Acc, T));
+t_bitstr_concat_1([], Acc) ->
+ Acc.
+
+-spec t_bitstr_concat(erl_type(), erl_type()) -> erl_type().
+
+t_bitstr_concat(T1, T2) ->
+ T1p = t_inf(t_bitstr(), T1),
+ T2p = t_inf(t_bitstr(), T2),
+ bitstr_concat(t_unopaque(T1p), t_unopaque(T2p)).
+
+-spec t_bitstr_match(erl_type(), erl_type()) -> erl_type().
+
+t_bitstr_match(T1, T2) ->
+ T1p = t_inf(t_bitstr(), T1),
+ T2p = t_inf(t_bitstr(), T2),
+ bitstr_match(t_unopaque(T1p), t_unopaque(T2p)).
+
+-spec t_is_bitstr(erl_type()) -> boolean().
+
+t_is_bitstr(Type) ->
+ t_is_bitstr(Type, 'universe').
+
+-spec t_is_bitstr(erl_type(), opaques()) -> boolean().
+
+t_is_bitstr(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_bitstr/1).
+
+is_bitstr(?bitstr(_, _)) -> true;
+is_bitstr(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Matchstates
+%%
+
+-spec t_matchstate() -> erl_type().
+
+t_matchstate() ->
+ ?any_matchstate.
+
+-spec t_matchstate(erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate(Init, 0) ->
+ ?matchstate(Init, Init);
+t_matchstate(Init, Max) when is_integer(Max) ->
+ Slots = [Init|[?none || _ <- lists:seq(1, Max)]],
+ ?matchstate(Init, t_product(Slots)).
+
+-spec t_is_matchstate(erl_type()) -> boolean().
+
+t_is_matchstate(?matchstate(_, _)) -> true;
+t_is_matchstate(_) -> false.
+
+-spec t_matchstate_present(erl_type()) -> erl_type().
+
+t_matchstate_present(Type) ->
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(P, _) -> P;
+ _ -> ?none
+ end.
+
+-spec t_matchstate_slot(erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate_slot(Type, Slot) ->
+ RealSlot = Slot + 1,
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(_, ?any) -> ?any;
+ ?matchstate(_, ?product(Vals)) when length(Vals) >= RealSlot ->
+ lists:nth(RealSlot, Vals);
+ ?matchstate(_, ?product(_)) ->
+ ?none;
+ ?matchstate(_, SlotType) when RealSlot =:= 1 ->
+ SlotType;
+ _ ->
+ ?none
+ end.
+
+-spec t_matchstate_slots(erl_type()) -> erl_type().
+
+t_matchstate_slots(?matchstate(_, Slots)) ->
+ Slots.
+
+-spec t_matchstate_update_present(erl_type(), erl_type()) -> erl_type().
+
+t_matchstate_update_present(New, Type) ->
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(_, Slots) ->
+ ?matchstate(New, Slots);
+ _ -> ?none
+ end.
+
+-spec t_matchstate_update_slot(erl_type(), erl_type(), non_neg_integer()) -> erl_type().
+
+t_matchstate_update_slot(New, Type, Slot) ->
+ RealSlot = Slot + 1,
+ case t_inf(t_matchstate(), Type) of
+ ?matchstate(Pres, Slots) ->
+ NewSlots =
+ case Slots of
+ ?any ->
+ ?any;
+ ?product(Vals) when length(Vals) >= RealSlot ->
+ NewTuple = setelement(RealSlot, list_to_tuple(Vals), New),
+ NewVals = tuple_to_list(NewTuple),
+ ?product(NewVals);
+ ?product(_) ->
+ ?none;
+ _ when RealSlot =:= 1 ->
+ New;
+ _ ->
+ ?none
+ end,
+ ?matchstate(Pres, NewSlots);
+ _ ->
+ ?none
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Functions
+%%
+
+-spec t_fun() -> erl_type().
+
+t_fun() ->
+ ?function(?any, ?any).
+
+-spec t_fun(erl_type()) -> erl_type().
+
+t_fun(Range) ->
+ ?function(?any, Range).
+
+-spec t_fun([erl_type()] | arity(), erl_type()) -> erl_type().
+
+t_fun(Domain, Range) when is_list(Domain) ->
+ ?function(?product(Domain), Range);
+t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 ->
+ ?function(?product(lists:duplicate(Arity, ?any)), Range).
+
+-spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()].
+
+t_fun_args(Type) ->
+ t_fun_args(Type, 'universe').
+
+-spec t_fun_args(erl_type(), opaques()) -> 'unknown' | [erl_type()].
+
+t_fun_args(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun fun_args/1).
+
+fun_args(?function(?any, _)) ->
+ unknown;
+fun_args(?function(?product(Domain), _)) when is_list(Domain) ->
+ Domain.
+
+-spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer().
+
+t_fun_arity(Type) ->
+ t_fun_arity(Type, 'universe').
+
+-spec t_fun_arity(erl_type(), opaques()) -> 'unknown' | non_neg_integer().
+
+t_fun_arity(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun fun_arity/1).
+
+fun_arity(?function(?any, _)) ->
+ unknown;
+fun_arity(?function(?product(Domain), _)) ->
+ length(Domain).
+
+-spec t_fun_range(erl_type()) -> erl_type().
+
+t_fun_range(Type) ->
+ t_fun_range(Type, 'universe').
+
+-spec t_fun_range(erl_type(), opaques()) -> erl_type().
+
+t_fun_range(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun fun_range/1).
+
+fun_range(?function(_, Range)) ->
+ Range.
+
+-spec t_is_fun(erl_type()) -> boolean().
+
+t_is_fun(Type) ->
+ t_is_fun(Type, 'universe').
+
+-spec t_is_fun(erl_type(), opaques()) -> boolean().
+
+t_is_fun(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_fun/1).
+
+is_fun(?function(_, _)) -> true;
+is_fun(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Identifiers. Includes ports, pids and refs.
+%%
+
+-spec t_identifier() -> erl_type().
+
+t_identifier() ->
+ ?identifier(?any).
+
+-spec t_is_identifier(erl_type()) -> boolean().
+
+t_is_identifier(?identifier(_)) -> true;
+t_is_identifier(_) -> false.
+
+%%------------------------------------
+
+-spec t_port() -> erl_type().
+
+t_port() ->
+ ?identifier(set_singleton(?port_qual)).
+
+-spec t_is_port(erl_type()) -> boolean().
+
+t_is_port(Type) ->
+ t_is_port(Type, 'universe').
+
+-spec t_is_port(erl_type(), opaques()) -> boolean().
+
+t_is_port(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_port1/1).
+
+is_port1(?identifier(?any)) -> false;
+is_port1(?identifier(Set)) -> set_is_singleton(?port_qual, Set);
+is_port1(_) -> false.
+
+%%------------------------------------
+
+-spec t_pid() -> erl_type().
+
+t_pid() ->
+ ?identifier(set_singleton(?pid_qual)).
+
+-spec t_is_pid(erl_type()) -> boolean().
+
+t_is_pid(Type) ->
+ t_is_pid(Type, 'universe').
+
+-spec t_is_pid(erl_type(), opaques()) -> boolean().
+
+t_is_pid(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_pid1/1).
+
+is_pid1(?identifier(?any)) -> false;
+is_pid1(?identifier(Set)) -> set_is_singleton(?pid_qual, Set);
+is_pid1(_) -> false.
+
+%%------------------------------------
+
+-spec t_reference() -> erl_type().
+
+t_reference() ->
+ ?identifier(set_singleton(?reference_qual)).
+
+-spec t_is_reference(erl_type()) -> boolean().
+
+t_is_reference(Type) ->
+ t_is_reference(Type, 'universe').
+
+-spec t_is_reference(erl_type(), opaques()) -> boolean().
+
+t_is_reference(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_reference1/1).
+
+is_reference1(?identifier(?any)) -> false;
+is_reference1(?identifier(Set)) -> set_is_singleton(?reference_qual, Set);
+is_reference1(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Numbers are divided into floats, integers, chars and bytes.
+%%
+
+-spec t_number() -> erl_type().
+
+t_number() ->
+ ?number(?any, ?unknown_qual).
+
+-spec t_number(integer()) -> erl_type().
+
+t_number(X) when is_integer(X) ->
+ t_integer(X).
+
+-spec t_is_number(erl_type()) -> boolean().
+
+t_is_number(Type) ->
+ t_is_number(Type, 'universe').
+
+-spec t_is_number(erl_type(), opaques()) -> boolean().
+
+t_is_number(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_number/1).
+
+is_number(?number(_, _)) -> true;
+is_number(_) -> false.
+
+%% Currently, the type system collapses all floats to ?float and does
+%% not keep any information about their values. As a result, the list
+%% that this function returns contains only integers.
+
+-spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...].
+
+t_number_vals(Type) ->
+ t_number_vals(Type, 'universe').
+
+-spec t_number_vals(erl_type(), opaques()) -> 'unknown' | [integer(),...].
+
+t_number_vals(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun number_vals/1).
+
+number_vals(?int_set(Set)) -> set_to_list(Set);
+number_vals(?number(_, _)) -> unknown;
+number_vals(?opaque(_)) -> unknown;
+number_vals(Other) ->
+ Inf = t_inf(Other, t_number()),
+ false = t_is_none(Inf), % sanity check
+ number_vals(Inf).
+
+%%------------------------------------
+
+-spec t_float() -> erl_type().
+
+t_float() ->
+ ?float.
+
+-spec t_is_float(erl_type()) -> boolean().
+
+t_is_float(Type) ->
+ t_is_float(Type, 'universe').
+
+-spec t_is_float(erl_type(), opaques()) -> boolean().
+
+t_is_float(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_float1/1).
+
+is_float1(?float) -> true;
+is_float1(_) -> false.
+
+%%------------------------------------
+
+-spec t_integer() -> erl_type().
+
+t_integer() ->
+ ?integer(?any).
+
+-spec t_integer(integer()) -> erl_type().
+
+t_integer(I) when is_integer(I) ->
+ ?int_set(set_singleton(I)).
+
+-spec t_integers([integer()]) -> erl_type().
+
+t_integers(List) when is_list(List) ->
+ t_sup([t_integer(I) || I <- List]).
+
+-spec t_is_integer(erl_type()) -> boolean().
+
+t_is_integer(Type) ->
+ t_is_integer(Type, 'universe').
+
+-spec t_is_integer(erl_type(), opaques()) -> boolean().
+
+t_is_integer(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_integer1/1).
+
+is_integer1(?integer(_)) -> true;
+is_integer1(_) -> false.
+
+%%------------------------------------
+
+-spec t_byte() -> erl_type().
+
+t_byte() ->
+ ?byte.
+
+-spec t_is_byte(erl_type()) -> boolean().
+
+t_is_byte(?int_range(neg_inf, _)) -> false;
+t_is_byte(?int_range(_, pos_inf)) -> false;
+t_is_byte(?int_range(From, To))
+ when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_BYTE -> true;
+t_is_byte(?int_set(Set)) ->
+ (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE);
+t_is_byte(_) -> false.
+
+%%------------------------------------
+
+-spec t_char() -> erl_type().
+
+t_char() ->
+ ?char.
+
+-spec t_is_char(erl_type()) -> boolean().
+
+t_is_char(?int_range(neg_inf, _)) -> false;
+t_is_char(?int_range(_, pos_inf)) -> false;
+t_is_char(?int_range(From, To))
+ when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_CHAR -> true;
+t_is_char(?int_set(Set)) ->
+ (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_CHAR);
+t_is_char(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Lists
+%%
+
+-spec t_cons() -> erl_type().
+
+t_cons() ->
+ ?nonempty_list(?any, ?any).
+
+%% Note that if the tail argument can be a list, we must collapse the
+%% content of the list to include both the content of the tail list
+%% and the head of the cons. If for example the tail argument is any()
+%% then there can be any list in the tail and the content of the
+%% returned list must be any().
+
+-spec t_cons(erl_type(), erl_type()) -> erl_type().
+
+t_cons(?none, _) -> ?none;
+t_cons(_, ?none) -> ?none;
+t_cons(?unit, _) -> ?none;
+t_cons(_, ?unit) -> ?none;
+t_cons(Hd, ?nil) ->
+ ?nonempty_list(Hd, ?nil);
+t_cons(Hd, ?list(Contents, Termination, _)) ->
+ ?nonempty_list(t_sup(Contents, Hd), Termination);
+t_cons(Hd, Tail) ->
+ case cons_tail(t_inf(Tail, t_maybe_improper_list())) of
+ ?list(Contents, Termination, _Size) ->
+ %% Collapse the list part of the termination but keep the
+ %% non-list part intact.
+ NewTermination = t_sup(t_subtract(Tail, t_maybe_improper_list()),
+ Termination),
+ ?nonempty_list(t_sup(Hd, Contents), NewTermination);
+ ?nil -> ?nonempty_list(Hd, Tail);
+ ?none -> ?nonempty_list(Hd, Tail);
+ ?unit -> ?none
+ end.
+
+cons_tail(Type) ->
+ do_opaque(Type, 'universe', fun(T) -> T end).
+
+-spec t_is_cons(erl_type()) -> boolean().
+
+t_is_cons(Type) ->
+ t_is_cons(Type, 'universe').
+
+-spec t_is_cons(erl_type(), opaques()) -> boolean().
+
+t_is_cons(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_cons/1).
+
+is_cons(?nonempty_list(_, _)) -> true;
+is_cons(_) -> false.
+
+-spec t_cons_hd(erl_type()) -> erl_type().
+
+t_cons_hd(Type) ->
+ t_cons_hd(Type, 'universe').
+
+-spec t_cons_hd(erl_type(), opaques()) -> erl_type().
+
+t_cons_hd(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun cons_hd/1).
+
+cons_hd(?nonempty_list(Contents, _Termination)) -> Contents.
+
+-spec t_cons_tl(erl_type()) -> erl_type().
+
+t_cons_tl(Type) ->
+ t_cons_tl(Type, 'universe').
+
+-spec t_cons_tl(erl_type(), opaques()) -> erl_type().
+
+t_cons_tl(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun cons_tl/1).
+
+cons_tl(?nonempty_list(_Contents, Termination) = T) ->
+ t_sup(Termination, T).
+
+-spec t_nil() -> erl_type().
+
+t_nil() ->
+ ?nil.
+
+-spec t_is_nil(erl_type()) -> boolean().
+
+t_is_nil(Type) ->
+ t_is_nil(Type, 'universe').
+
+-spec t_is_nil(erl_type(), opaques()) -> boolean().
+
+t_is_nil(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_nil/1).
+
+is_nil(?nil) -> true;
+is_nil(_) -> false.
+
+-spec t_list() -> erl_type().
+
+t_list() ->
+ ?list(?any, ?nil, ?unknown_qual).
+
+-spec t_list(erl_type()) -> erl_type().
+
+t_list(?none) -> ?none;
+t_list(?unit) -> ?none;
+t_list(Contents) ->
+ ?list(Contents, ?nil, ?unknown_qual).
+
+-spec t_list_elements(erl_type()) -> erl_type().
+
+t_list_elements(Type) ->
+ t_list_elements(Type, 'universe').
+
+-spec t_list_elements(erl_type(), opaques()) -> erl_type().
+
+t_list_elements(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun list_elements/1).
+
+list_elements(?list(Contents, _, _)) -> Contents;
+list_elements(?nil) -> ?none.
+
+-spec t_list_termination(erl_type(), opaques()) -> erl_type().
+
+t_list_termination(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun t_list_termination/1).
+
+-spec t_list_termination(erl_type()) -> erl_type().
+
+t_list_termination(?nil) -> ?nil;
+t_list_termination(?list(_, Term, _)) -> Term.
+
+-spec t_is_list(erl_type()) -> boolean().
+
+t_is_list(?list(_Contents, ?nil, _)) -> true;
+t_is_list(?nil) -> true;
+t_is_list(_) -> false.
+
+-spec t_nonempty_list() -> erl_type().
+
+t_nonempty_list() ->
+ t_cons(?any, ?nil).
+
+-spec t_nonempty_list(erl_type()) -> erl_type().
+
+t_nonempty_list(Type) ->
+ t_cons(Type, ?nil).
+
+-spec t_nonempty_string() -> erl_type().
+
+t_nonempty_string() ->
+ t_nonempty_list(t_char()).
+
+-spec t_string() -> erl_type().
+
+t_string() ->
+ t_list(t_char()).
+
+-spec t_is_string(erl_type()) -> boolean().
+
+t_is_string(X) ->
+ t_is_list(X) andalso t_is_char(t_list_elements(X)).
+
+-spec t_maybe_improper_list() -> erl_type().
+
+t_maybe_improper_list() ->
+ ?list(?any, ?any, ?unknown_qual).
+
+%% Should only be used if you know what you are doing. See t_cons/2
+-spec t_maybe_improper_list(erl_type(), erl_type()) -> erl_type().
+
+t_maybe_improper_list(_Content, ?unit) -> ?none;
+t_maybe_improper_list(?unit, _Termination) -> ?none;
+t_maybe_improper_list(Content, Termination) ->
+ %% Safety check: would be nice to have but does not work with remote types
+ %% true = t_is_subtype(t_nil(), Termination),
+ ?list(Content, Termination, ?unknown_qual).
+
+-spec t_is_maybe_improper_list(erl_type()) -> boolean().
+
+t_is_maybe_improper_list(Type) ->
+ t_is_maybe_improper_list(Type, 'universe').
+
+-spec t_is_maybe_improper_list(erl_type(), opaques()) -> boolean().
+
+t_is_maybe_improper_list(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_maybe_improper_list/1).
+
+is_maybe_improper_list(?list(_, _, _)) -> true;
+is_maybe_improper_list(?nil) -> true;
+is_maybe_improper_list(_) -> false.
+
+%% %% Should only be used if you know what you are doing. See t_cons/2
+%% -spec t_improper_list(erl_type(), erl_type()) -> erl_type().
+%%
+%% t_improper_list(?unit, _Termination) -> ?none;
+%% t_improper_list(_Content, ?unit) -> ?none;
+%% t_improper_list(Content, Termination) ->
+%% %% Safety check: would be nice to have but does not work with remote types
+%% %% false = t_is_subtype(t_nil(), Termination),
+%% ?list(Content, Termination, ?any).
+
+-spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type().
+
+lift_list_to_pos_empty(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1).
+
+-spec lift_list_to_pos_empty(erl_type()) -> erl_type().
+
+lift_list_to_pos_empty(?nil) -> ?nil;
+lift_list_to_pos_empty(?list(Content, Termination, _)) ->
+ ?list(Content, Termination, ?unknown_qual).
+
+-spec t_widen_to_number(erl_type()) -> erl_type().
+
+%% Widens integers and floats to t_number().
+%% Used by erl_bif_types:key_comparison_fail().
+
+t_widen_to_number(?any) -> ?any;
+t_widen_to_number(?none) -> ?none;
+t_widen_to_number(?unit) -> ?unit;
+t_widen_to_number(?atom(_Set) = T) -> T;
+t_widen_to_number(?bitstr(_Unit, _Base) = T) -> T;
+t_widen_to_number(?float) -> t_number();
+t_widen_to_number(?function(Domain, Range)) ->
+ ?function(t_widen_to_number(Domain), t_widen_to_number(Range));
+t_widen_to_number(?identifier(_Types) = T) -> T;
+t_widen_to_number(?int_range(_From, _To)) -> t_number();
+t_widen_to_number(?int_set(_Set)) -> t_number();
+t_widen_to_number(?integer(_Types)) -> t_number();
+t_widen_to_number(?list(Type, Tail, Size)) ->
+ ?list(t_widen_to_number(Type), t_widen_to_number(Tail), Size);
+t_widen_to_number(?map(Pairs, DefK, DefV)) ->
+ L = [{t_widen_to_number(K), MNess, t_widen_to_number(V)} ||
+ {K, MNess, V} <- Pairs],
+ t_map(L, t_widen_to_number(DefK), t_widen_to_number(DefV));
+t_widen_to_number(?matchstate(_P, _Slots) = T) -> T;
+t_widen_to_number(?nil) -> ?nil;
+t_widen_to_number(?number(_Set, _Tag)) -> t_number();
+t_widen_to_number(?opaque(Set)) ->
+ L = [Opaque#opaque{struct = t_widen_to_number(S)} ||
+ #opaque{struct = S} = Opaque <- set_to_list(Set)],
+ ?opaque(ordsets:from_list(L));
+t_widen_to_number(?product(Types)) ->
+ ?product(list_widen_to_number(Types));
+t_widen_to_number(?tuple(?any, _, _) = T) -> T;
+t_widen_to_number(?tuple(Types, Arity, Tag)) ->
+ ?tuple(list_widen_to_number(Types), Arity, Tag);
+t_widen_to_number(?tuple_set(_) = Tuples) ->
+ t_sup([t_widen_to_number(T) || T <- t_tuple_subtypes(Tuples)]);
+t_widen_to_number(?union(List)) ->
+ ?union(list_widen_to_number(List));
+t_widen_to_number(?var(_Id)= T) -> T.
+
+list_widen_to_number(List) ->
+ [t_widen_to_number(E) || E <- List].
+
+%%-----------------------------------------------------------------------------
+%% Maps
+%%
+%% Representation:
+%% ?map(Pairs, DefaultKey, DefaultValue)
+%%
+%% Pairs is a sorted dictionary of types with a mandatoriness tag on each pair
+%% (t_map_dict()). DefaultKey and DefaultValue are plain types.
+%%
+%% A map M belongs to this type iff
+%% For each pair {KT, mandatory, VT} in Pairs, there exists a pair {K, V} in M
+%% such that K \in KT and V \in VT.
+%% For each pair {KT, optional, VT} in Pairs, either there exists no key K in
+%% M s.t. K in KT, or there exists a pair {K, V} in M such that K \in KT and
+%% V \in VT.
+%% For each remaining pair {K, V} in M (where remaining means that there is no
+%% key KT in Pairs s.t. K \in KT), K \in DefaultKey and V \in DefaultValue.
+%%
+%% Invariants:
+%% * The keys in Pairs are singleton types.
+%% * The values of Pairs must not be unit, and may only be none if the
+%% mandatoriness tag is 'optional'.
+%% * There is no pair {K, 'optional', V} in Pairs s.t.
+%% K is a subtype of DefaultKey and V is equal to DefaultValue.
+%% * DefaultKey must be the empty type iff DefaultValue is the empty type.
+%% * DefaultKey must not be a singleton type.
+%% * For every key K in Pairs, DefaultKey - K must not be representable; i.e.
+%% t_subtract(DefaultKey, K) must return DefaultKey.
+%% * For every pair {K, 'optional', ?none} in Pairs, K must be a subtype of
+%% DefaultKey.
+%% * Pairs must be sorted and not contain any duplicate keys.
+%%
+%% These invariants ensure that equal map types are represented by equal terms.
+
+-define(mand, mandatory).
+-define(opt, optional).
+
+-type t_map_mandatoriness() :: ?mand | ?opt.
+-type t_map_pair() :: {erl_type(), t_map_mandatoriness(), erl_type()}.
+-type t_map_dict() :: [t_map_pair()].
+
+-spec t_map() -> erl_type().
+
+t_map() ->
+ t_map([], t_any(), t_any()).
+
+-spec t_map([{erl_type(), erl_type()}]) -> erl_type().
+
+t_map(L) ->
+ lists:foldl(fun t_map_put/2, t_map(), L).
+
+-spec t_map(t_map_dict(), erl_type(), erl_type()) -> erl_type().
+
+t_map(Pairs0, DefK0, DefV0) ->
+ DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0),
+ {DefK2, DefV1} =
+ case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of
+ true -> {?none, ?none};
+ false -> {DefK1, DefV0}
+ end,
+ {Pairs1, DefK, DefV}
+ = case is_singleton_type(DefK2) of
+ true -> {mapdict_insert({DefK2, ?opt, DefV1}, Pairs0), ?none, ?none};
+ false -> {Pairs0, DefK2, DefV1}
+ end,
+ Pairs = normalise_map_optionals(Pairs1, DefK, DefV),
+ %% Validate invariants of the map representation.
+ %% Since we needed to iterate over the arguments in order to normalise anyway,
+ %% we might as well save us some future pain and do this even without
+ %% define(DEBUG, true).
+ try
+ validate_map_elements(Pairs)
+ catch error:badarg -> error(badarg, [Pairs0,DefK0,DefV0])
+ end,
+ case map_pairs_are_none(Pairs) of
+ true -> ?none;
+ false -> ?map(Pairs, DefK, DefV)
+ end.
+
+normalise_map_optionals([], _, _) -> [];
+normalise_map_optionals([E={K,?opt,?none}|T], DefK, DefV) ->
+ Diff = t_subtract(DefK, K),
+ case t_is_subtype(K, DefK) andalso DefK =:= Diff of
+ true -> [E|normalise_map_optionals(T, DefK, DefV)];
+ false -> normalise_map_optionals(T, Diff, DefV)
+ end;
+normalise_map_optionals([E={K,?opt,V}|T], DefK, DefV) ->
+ case t_is_equal(V, DefV) andalso t_is_subtype(K, DefK) of
+ true -> normalise_map_optionals(T, DefK, DefV);
+ false -> [E|normalise_map_optionals(T, DefK, DefV)]
+ end;
+normalise_map_optionals([E|T], DefK, DefV) ->
+ [E|normalise_map_optionals(T, DefK, DefV)].
+
+validate_map_elements([{K1,_,_}|Rest=[{K2,_,_}|_]]) ->
+ case is_singleton_type(K1) andalso K1 < K2 of
+ false -> error(badarg);
+ true -> validate_map_elements(Rest)
+ end;
+validate_map_elements([{K,_,_}]) ->
+ case is_singleton_type(K) of
+ false -> error(badarg);
+ true -> true
+ end;
+validate_map_elements([]) -> true.
+
+map_pairs_are_none([]) -> false;
+map_pairs_are_none([{_,?mand,?none}|_]) -> true;
+map_pairs_are_none([_|Ps]) -> map_pairs_are_none(Ps).
+
+-spec t_is_map(erl_type()) -> boolean().
+
+t_is_map(Type) ->
+ t_is_map(Type, 'universe').
+
+-spec t_is_map(erl_type(), opaques()) -> boolean().
+
+t_is_map(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_map1/1).
+
+is_map1(?map(_, _, _)) -> true;
+is_map1(_) -> false.
+
+-spec t_map_entries(erl_type()) -> t_map_dict().
+
+t_map_entries(M) ->
+ t_map_entries(M, 'universe').
+
+-spec t_map_entries(erl_type(), opaques()) -> t_map_dict().
+
+t_map_entries(M, Opaques) ->
+ do_opaque(M, Opaques, fun map_entries/1).
+
+map_entries(?map(Pairs,_,_)) ->
+ Pairs.
+
+-spec t_map_def_key(erl_type()) -> erl_type().
+
+t_map_def_key(M) ->
+ t_map_def_key(M, 'universe').
+
+-spec t_map_def_key(erl_type(), opaques()) -> erl_type().
+
+t_map_def_key(M, Opaques) ->
+ do_opaque(M, Opaques, fun map_def_key/1).
+
+map_def_key(?map(_,DefK,_)) ->
+ DefK.
+
+-spec t_map_def_val(erl_type()) -> erl_type().
+
+t_map_def_val(M) ->
+ t_map_def_val(M, 'universe').
+
+-spec t_map_def_val(erl_type(), opaques()) -> erl_type().
+
+t_map_def_val(M, Opaques) ->
+ do_opaque(M, Opaques, fun map_def_val/1).
+
+map_def_val(?map(_,_,DefV)) ->
+ DefV.
+
+-spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict().
+
+mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T];
+mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 ->
+ [E2|mapdict_store(E1, T)];
+mapdict_store(E={_,_,_}, T) -> [E|T].
+
+-spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict().
+
+mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]);
+mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 ->
+ [E2|mapdict_insert(E1, T)];
+mapdict_insert(E={_,_,_}, T) -> [E|T].
+
+-type map_pairwise_merge_fun() :: fun((erl_type(),
+ t_map_mandatoriness(), erl_type(),
+ t_map_mandatoriness(), erl_type())
+ -> t_map_pair() | false).
+
+-spec t_map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type(),
+ opaques()) -> t_map_dict().
+t_map_pairwise_merge(F, MapA, MapB, Opaques) ->
+ do_opaque(MapA, Opaques,
+ fun(UMapA) ->
+ do_opaque(MapB, Opaques,
+ fun(UMapB) ->
+ map_pairwise_merge(F, UMapA, UMapB)
+ end)
+ end).
+
+%% Merges the pairs of two maps together. Missing pairs become (?opt, DefV) or
+%% (?opt, ?none), depending on whether K \in DefK.
+-spec map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type())
+ -> t_map_dict().
+map_pairwise_merge(F, ?map(APairs, ADefK, ADefV),
+ ?map(BPairs, BDefK, BDefV)) ->
+ map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV).
+
+map_pairwise_merge(_, [], _, _, [], _, _) -> [];
+map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) ->
+ {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} =
+ case {As0, Bs0} of
+ {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} ->
+ {K, AMNess, AV, As, BMNess, BV, Bs};
+ {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK ->
+ {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs};
+ {As, [{K, BMNess,BV}|Bs]} ->
+ {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs};
+ {[{K,AMNess,AV}|As], []=Bs} ->
+ {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}
+ end,
+ MK = K1, %% Rename to make clear that we are matching below
+ case F(K1, AMNess1, AV1, BMNess1, BV1) of
+ false -> map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV);
+ {MK,_,_}=M -> [M|map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV)]
+ end.
+
+%% Folds over the pairs in two maps simultaneously in reverse key order. Missing
+%% pairs become (?opt, DefV) or (?opt, ?none), depending on whether K \in DefK.
+-spec map_pairwise_merge_foldr(fun((erl_type(),
+ t_map_mandatoriness(), erl_type(),
+ t_map_mandatoriness(), erl_type(),
+ Acc) -> Acc),
+ Acc, erl_type(), erl_type()) -> Acc.
+
+map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV),
+ ?map(BPairs, BDefK, BDefV)) ->
+ map_pairwise_merge_foldr(F, AccIn, APairs, ADefK, ADefV, BPairs, BDefK, BDefV).
+
+map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc;
+map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) ->
+ {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} =
+ case {As0, Bs0} of
+ {[{K,AMNess,AV}|As], [{K,BMNess,BV}|Bs]} ->
+ {K, AMNess, AV, As, BMNess, BV, Bs};
+ {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK ->
+ {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs};
+ {As, [{K,BMNess,BV}|Bs]} ->
+ {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs};
+ {[{K,AMNess,AV}|As], []=Bs} ->
+ {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}
+ end,
+ F(K1, AMNess1, AV1, BMNess1, BV1,
+ map_pairwise_merge_foldr(F,AccIn,As1,ADefK,ADefV,Bs1,BDefK,BDefV)).
+
+%% By observing that a missing pair in a map is equivalent to an optional pair,
+%% with ?none or DefV value, depending on whether K \in DefK, we can simplify
+%% merging by denormalising the map pairs temporarily, removing all 'false'
+%% cases, at the cost of the creation of more tuples:
+mapmerge_otherv(K, ODefK, ODefV) ->
+ case t_inf(K, ODefK) of
+ ?none -> ?none;
+ _KOrOpaque -> ODefV
+ end.
+
+-spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type().
+
+t_map_put(KV, Map) ->
+ t_map_put(KV, Map, 'universe').
+
+-spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type().
+
+t_map_put(KV, Map, Opaques) ->
+ do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end).
+
+%% Key and Value are *not* unopaqued, but the map is
+map_put(_, ?none, _) -> ?none;
+map_put(_, ?unit, _) -> ?none;
+map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) ->
+ case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of
+ true -> ?none;
+ false ->
+ case is_singleton_type(Key) of
+ true ->
+ t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV);
+ false ->
+ t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of
+ true -> V;
+ false -> t_sup(V, Value)
+ end} || {K, MNess, V} <- Pairs],
+ t_sup(DefK, Key),
+ t_sup(DefV, Value))
+ end
+ end.
+
+-spec t_map_remove(erl_type(), erl_type(), opaques()) -> erl_type().
+
+t_map_remove(Key, Map, Opaques) ->
+ do_opaque(Map, Opaques, fun(UM) -> map_remove(Key, UM) end).
+
+map_remove(_, ?none) -> ?none;
+map_remove(_, ?unit) -> ?none;
+map_remove(Key, Map) ->
+ %% ?map(lists:keydelete(Key, 1, Pairs), DefK, DefV).
+ case is_singleton_type(Key) of
+ false -> Map;
+ true ->
+ ?map(Pairs,DefK,DefV) = Map,
+ case lists:keyfind(Key, 1, Pairs) of
+ false -> Map;
+ {Key, _, _} ->
+ Pairs1 = lists:keydelete(Key, 1, Pairs),
+ t_map(Pairs1, DefK, DefV)
+ end
+ end.
+
+-spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type().
+
+t_map_update(KV, Map) ->
+ t_map_update(KV, Map, 'universe').
+
+-spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type().
+
+t_map_update(_, ?none, _) -> ?none;
+t_map_update(_, ?unit, _) -> ?none;
+t_map_update(KV={Key, _}, M, Opaques) ->
+ case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of
+ false -> ?none;
+ true -> t_map_put(KV, M, Opaques)
+ end.
+
+-spec t_map_get(erl_type(), erl_type()) -> erl_type().
+
+t_map_get(Key, Map) ->
+ t_map_get(Key, Map, 'universe').
+
+-spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type().
+
+t_map_get(Key, Map, Opaques) ->
+ do_opaque(Map, Opaques,
+ fun(UM) ->
+ do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end)
+ end).
+
+map_get(_, ?none) -> ?none;
+map_get(_, ?unit) -> ?none;
+map_get(Key, ?map(Pairs, DefK, DefV)) ->
+ DefRes =
+ case t_do_overlap(DefK, Key) of
+ false -> t_none();
+ true -> DefV
+ end,
+ case is_singleton_type(Key) of
+ false ->
+ lists:foldl(fun({K, _, V}, Res) ->
+ case t_do_overlap(K, Key) of
+ false -> Res;
+ true -> t_sup(Res, V)
+ end
+ end, DefRes, Pairs);
+ true ->
+ case lists:keyfind(Key, 1, Pairs) of
+ false -> DefRes;
+ {_, _, ValType} -> ValType
+ end
+ end.
+
+-spec t_map_is_key(erl_type(), erl_type()) -> erl_type().
+
+t_map_is_key(Key, Map) ->
+ t_map_is_key(Key, Map, 'universe').
+
+-spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type().
+
+t_map_is_key(Key, Map, Opaques) ->
+ do_opaque(Map, Opaques,
+ fun(UM) ->
+ do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end)
+ end).
+
+map_is_key(_, ?none) -> ?none;
+map_is_key(_, ?unit) -> ?none;
+map_is_key(Key, ?map(Pairs, DefK, _DefV)) ->
+ case is_singleton_type(Key) of
+ true ->
+ case lists:keyfind(Key, 1, Pairs) of
+ {Key, ?mand, _} -> t_atom(true);
+ {Key, ?opt, ?none} -> t_atom(false);
+ {Key, ?opt, _} -> t_boolean();
+ false ->
+ case t_do_overlap(DefK, Key) of
+ false -> t_atom(false);
+ true -> t_boolean()
+ end
+ end;
+ false ->
+ case t_do_overlap(DefK, Key)
+ orelse lists:any(fun({_,_,?none}) -> false;
+ ({K,_,_}) -> t_do_overlap(K, Key)
+ end, Pairs)
+ of
+ true -> t_boolean();
+ false -> t_atom(false)
+ end
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Tuples
+%%
+
+-spec t_tuple() -> erl_type().
+
+t_tuple() ->
+ ?tuple(?any, ?any, ?any).
+
+-spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type().
+
+t_tuple(N) when is_integer(N), N > ?MAX_TUPLE_SIZE ->
+ t_tuple();
+t_tuple(N) when is_integer(N) ->
+ ?tuple(lists:duplicate(N, ?any), N, ?any);
+t_tuple(List) ->
+ case any_none_or_unit(List) of
+ true -> t_none();
+ false ->
+ Arity = length(List),
+ case get_tuple_tags(List) of
+ [Tag] -> ?tuple(List, Arity, Tag); %% Tag can also be ?any here
+ TagList ->
+ SortedTagList = lists:sort(TagList),
+ Tuples = [?tuple([T|tl(List)], Arity, T) || T <- SortedTagList],
+ ?tuple_set([{Arity, Tuples}])
+ end
+ end.
+
+-spec get_tuple_tags([erl_type()]) -> [erl_type(),...].
+
+get_tuple_tags([Tag|_]) ->
+ do_opaque(Tag, 'universe', fun tuple_tags/1);
+get_tuple_tags(_) -> [?any].
+
+tuple_tags(?atom(?any)) -> [?any];
+tuple_tags(?atom(Set)) ->
+ case set_size(Set) > ?TUPLE_TAG_LIMIT of
+ true -> [?any];
+ false -> [t_atom(A) || A <- set_to_list(Set)]
+ end;
+tuple_tags(_) -> [?any].
+
+%% to be used for a tuple with known types for its arguments (not ?any)
+-spec t_tuple_args(erl_type()) -> [erl_type()].
+
+t_tuple_args(Type) ->
+ t_tuple_args(Type, 'universe').
+
+%% to be used for a tuple with known types for its arguments (not ?any)
+-spec t_tuple_args(erl_type(), opaques()) -> [erl_type()].
+
+t_tuple_args(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun tuple_args/1).
+
+tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args.
+
+%% to be used for a tuple with a known size (not ?any)
+-spec t_tuple_size(erl_type()) -> non_neg_integer().
+
+t_tuple_size(Type) ->
+ t_tuple_size(Type, 'universe').
+
+%% to be used for a tuple with a known size (not ?any)
+-spec t_tuple_size(erl_type(), opaques()) -> non_neg_integer().
+
+t_tuple_size(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun tuple_size1/1).
+
+tuple_size1(?tuple(_, Size, _)) when is_integer(Size) -> Size.
+
+-spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...].
+
+t_tuple_sizes(Type) ->
+ do_opaque(Type, 'universe', fun tuple_sizes/1).
+
+tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown;
+tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size];
+tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List].
+
+-spec t_tuple_subtypes(erl_type(), opaques()) ->
+ 'unknown' | [erl_type(),...].
+
+t_tuple_subtypes(Type, Opaques) ->
+ Fun = fun(?tuple_set(List)) ->
+ t_tuple_subtypes_tuple_list(List, Opaques);
+ (?opaque(_)) -> unknown;
+ (T) -> t_tuple_subtypes(T)
+ end,
+ do_opaque(Type, Opaques, Fun).
+
+t_tuple_subtypes_tuple_list(List, Opaques) ->
+ lists:append([t_tuple_subtypes_list(Tuples, Opaques) ||
+ {_Size, Tuples} <- List]).
+
+t_tuple_subtypes_list(List, Opaques) ->
+ ListOfLists = [t_tuple_subtypes(E, Opaques) || E <- List, E =/= ?none],
+ lists:append([L || L <- ListOfLists, L =/= 'unknown']).
+
+-spec t_tuple_subtypes(erl_type()) -> 'unknown' | [erl_type(),...].
+
+%% XXX. Not the same as t_tuple_subtypes(T, 'universe')...
+t_tuple_subtypes(?tuple(?any, ?any, ?any)) -> unknown;
+t_tuple_subtypes(?tuple(_, _, _) = T) -> [T];
+t_tuple_subtypes(?tuple_set(List)) ->
+ lists:append([Tuples || {_Size, Tuples} <- List]).
+
+-spec t_is_tuple(erl_type()) -> boolean().
+
+t_is_tuple(Type) ->
+ t_is_tuple(Type, 'universe').
+
+-spec t_is_tuple(erl_type(), opaques()) -> boolean().
+
+t_is_tuple(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_tuple1/1).
+
+is_tuple1(?tuple(_, _, _)) -> true;
+is_tuple1(?tuple_set(_)) -> true;
+is_tuple1(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Non-primitive types, including some handy syntactic sugar types
+%%
+
+-spec t_bitstrlist() -> erl_type().
+
+t_bitstrlist() ->
+ t_iolist(1, t_bitstr()).
+
+-spec t_arity() -> erl_type().
+
+t_arity() ->
+ t_from_range(0, 255). % was t_byte().
+
+-spec t_pos_integer() -> erl_type().
+
+t_pos_integer() ->
+ t_from_range(1, pos_inf).
+
+-spec t_non_neg_integer() -> erl_type().
+
+t_non_neg_integer() ->
+ t_from_range(0, pos_inf).
+
+-spec t_is_non_neg_integer(erl_type()) -> boolean().
+
+t_is_non_neg_integer(?integer(_) = T) ->
+ t_is_subtype(T, t_non_neg_integer());
+t_is_non_neg_integer(_) -> false.
+
+-spec t_neg_integer() -> erl_type().
+
+t_neg_integer() ->
+ t_from_range(neg_inf, -1).
+
+-spec t_fixnum() -> erl_type().
+
+t_fixnum() ->
+ t_integer(). % Gross over-approximation
+
+-spec t_pos_fixnum() -> erl_type().
+
+t_pos_fixnum() ->
+ t_pos_integer(). % Gross over-approximation
+
+-spec t_non_neg_fixnum() -> erl_type().
+
+t_non_neg_fixnum() ->
+ t_non_neg_integer(). % Gross over-approximation
+
+-spec t_mfa() -> erl_type().
+
+t_mfa() ->
+ t_tuple([t_atom(), t_atom(), t_arity()]).
+
+-spec t_module() -> erl_type().
+
+t_module() ->
+ t_atom().
+
+-spec t_node() -> erl_type().
+
+t_node() ->
+ t_atom().
+
+-spec t_iodata() -> erl_type().
+
+t_iodata() ->
+ t_sup(t_iolist(), t_binary()).
+
+-spec t_iolist() -> erl_type().
+
+t_iolist() ->
+ t_iolist(1, t_binary()).
+
+%% Added a second argument which currently is t_binary() | t_bitstr()
+-spec t_iolist(non_neg_integer(), erl_type()) -> erl_type().
+
+t_iolist(N, T) when N > 0 ->
+ t_maybe_improper_list(t_sup([t_iolist(N-1, T), T, t_byte()]),
+ t_sup(T, t_nil()));
+t_iolist(0, T) ->
+ t_maybe_improper_list(t_any(), t_sup(T, t_nil())).
+
+-spec t_timeout() -> erl_type().
+
+t_timeout() ->
+ t_sup(t_non_neg_integer(), t_atom('infinity')).
+
+%%------------------------------------
+
+%% ?none is allowed in products. A product of size 1 is not a product.
+
+-spec t_product([erl_type()]) -> erl_type().
+
+t_product([T]) -> T;
+t_product(Types) when is_list(Types) ->
+ ?product(Types).
+
+%% This function is intended to be the inverse of the one above.
+%% It should NOT be used with ?any, ?none or ?unit as input argument.
+
+-spec t_to_tlist(erl_type()) -> [erl_type()].
+
+t_to_tlist(?product(Types)) -> Types;
+t_to_tlist(T) when T =/= ?any orelse T =/= ?none orelse T =/= ?unit -> [T].
+
+%%------------------------------------
+
+-spec t_var(atom() | integer()) -> erl_type().
+
+t_var(Atom) when is_atom(Atom) -> ?var(Atom);
+t_var(Int) when is_integer(Int) -> ?var(Int).
+
+-spec t_is_var(erl_type()) -> boolean().
+
+t_is_var(?var(_)) -> true;
+t_is_var(_) -> false.
+
+-spec t_var_name(erl_type()) -> atom() | integer().
+
+t_var_name(?var(Id)) -> Id.
+
+-spec t_has_var(erl_type()) -> boolean().
+
+t_has_var(?var(_)) -> true;
+t_has_var(?function(Domain, Range)) ->
+ t_has_var(Domain) orelse t_has_var(Range);
+t_has_var(?list(Contents, Termination, _)) ->
+ t_has_var(Contents) orelse t_has_var(Termination);
+t_has_var(?product(Types)) -> t_has_var_list(Types);
+t_has_var(?tuple(?any, ?any, ?any)) -> false;
+t_has_var(?tuple(Elements, _, _)) ->
+ t_has_var_list(Elements);
+t_has_var(?tuple_set(_) = T) ->
+ t_has_var_list(t_tuple_subtypes(T));
+t_has_var(?map(_, DefK, _)= Map) ->
+ t_has_var_list(map_all_values(Map)) orelse
+ t_has_var(DefK);
+t_has_var(?opaque(Set)) ->
+ %% Assume variables in 'args' are also present i 'struct'
+ t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]);
+t_has_var(?union(List)) ->
+ t_has_var_list(List);
+t_has_var(_) -> false.
+
+-spec t_has_var_list([erl_type()]) -> boolean().
+
+t_has_var_list([T|Ts]) ->
+ t_has_var(T) orelse t_has_var_list(Ts);
+t_has_var_list([]) -> false.
+
+-spec t_collect_vars(erl_type()) -> [erl_type()].
+
+t_collect_vars(T) ->
+ Vs = t_collect_vars(T, maps:new()),
+ [V || {V, _} <- maps:to_list(Vs)].
+
+-type ctab() :: #{erl_type() => 'any'}.
+
+-spec t_collect_vars(erl_type(), ctab()) -> ctab().
+
+t_collect_vars(?var(_) = Var, Acc) ->
+ maps:put(Var, any, Acc);
+t_collect_vars(?function(Domain, Range), Acc) ->
+ Acc1 = t_collect_vars(Domain, Acc),
+ t_collect_vars(Range, Acc1);
+t_collect_vars(?list(Contents, Termination, _), Acc) ->
+ Acc1 = t_collect_vars(Contents, Acc),
+ t_collect_vars(Termination, Acc1);
+t_collect_vars(?product(Types), Acc) ->
+ t_collect_vars_list(Types, Acc);
+t_collect_vars(?tuple(?any, ?any, ?any), Acc) ->
+ Acc;
+t_collect_vars(?tuple(Types, _, _), Acc) ->
+ t_collect_vars_list(Types, Acc);
+t_collect_vars(?tuple_set(_) = TS, Acc) ->
+ t_collect_vars_list(t_tuple_subtypes(TS), Acc);
+t_collect_vars(?map(_, DefK, _) = Map, Acc0) ->
+ Acc = t_collect_vars_list(map_all_values(Map), Acc0),
+ t_collect_vars(DefK, Acc);
+t_collect_vars(?opaque(Set), Acc) ->
+ %% Assume variables in 'args' are also present i 'struct'
+ t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc);
+t_collect_vars(?union(List), Acc) ->
+ t_collect_vars_list(List, Acc);
+t_collect_vars(_, Acc) ->
+ Acc.
+
+t_collect_vars_list([T|Ts], Acc0) ->
+ Acc = t_collect_vars(T, Acc0),
+ t_collect_vars_list(Ts, Acc);
+t_collect_vars_list([], Acc) -> Acc.
+
+%%=============================================================================
+%%
+%% Type construction from Erlang terms.
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Make a type from a term. No type depth is enforced.
+%%
+
+-spec t_from_term(term()) -> erl_type().
+
+t_from_term([H|T]) -> t_cons(t_from_term(H), t_from_term(T));
+t_from_term([]) -> t_nil();
+t_from_term(T) when is_atom(T) -> t_atom(T);
+t_from_term(T) when is_bitstring(T) -> t_bitstr(0, erlang:bit_size(T));
+t_from_term(T) when is_float(T) -> t_float();
+t_from_term(T) when is_function(T) ->
+ {arity, Arity} = erlang:fun_info(T, arity),
+ t_fun(Arity, t_any());
+t_from_term(T) when is_integer(T) -> t_integer(T);
+t_from_term(T) when is_map(T) ->
+ Pairs = [{t_from_term(K), ?mand, t_from_term(V)}
+ || {K, V} <- maps:to_list(T)],
+ {Stons, Rest} = lists:partition(fun({K,_,_}) -> is_singleton_type(K) end,
+ Pairs),
+ {DefK, DefV}
+ = lists:foldl(fun({K,_,V},{AK,AV}) -> {t_sup(K,AK), t_sup(V,AV)} end,
+ {t_none(), t_none()}, Rest),
+ t_map(lists:keysort(1, Stons), DefK, DefV);
+t_from_term(T) when is_pid(T) -> t_pid();
+t_from_term(T) when is_port(T) -> t_port();
+t_from_term(T) when is_reference(T) -> t_reference();
+t_from_term(T) when is_tuple(T) ->
+ t_tuple([t_from_term(E) || E <- tuple_to_list(T)]).
+
+%%-----------------------------------------------------------------------------
+%% Integer types from a range.
+%%-----------------------------------------------------------------------------
+
+%%-define(USE_UNSAFE_RANGES, true).
+
+-spec t_from_range(rng_elem(), rng_elem()) -> erl_type().
+
+-ifdef(USE_UNSAFE_RANGES).
+
+t_from_range(X, Y) ->
+ t_from_range_unsafe(X, Y).
+
+-else.
+
+t_from_range(pos_inf, pos_inf) -> ?integer_pos;
+t_from_range(neg_inf, neg_inf) -> ?integer_neg;
+t_from_range(neg_inf, pos_inf) -> t_integer();
+t_from_range(neg_inf, Y) when is_integer(Y), Y < 0 -> ?integer_neg;
+t_from_range(neg_inf, Y) when is_integer(Y), Y >= 0 -> t_integer();
+t_from_range(X, pos_inf) when is_integer(X), X >= 1 -> ?integer_pos;
+t_from_range(X, pos_inf) when is_integer(X), X >= 0 -> ?integer_non_neg;
+t_from_range(X, pos_inf) when is_integer(X), X < 0 -> t_integer();
+t_from_range(X, Y) when is_integer(X), is_integer(Y), X > Y -> t_none();
+t_from_range(X, Y) when is_integer(X), is_integer(Y) ->
+ case ((Y - X) < ?SET_LIMIT) of
+ true -> t_integers(lists:seq(X, Y));
+ false ->
+ case X >= 0 of
+ false ->
+ if Y < 0 -> ?integer_neg;
+ true -> t_integer()
+ end;
+ true ->
+ if Y =< ?MAX_BYTE, X >= 1 -> ?int_range(1, ?MAX_BYTE);
+ Y =< ?MAX_BYTE -> t_byte();
+ Y =< ?MAX_CHAR, X >= 1 -> ?int_range(1, ?MAX_CHAR);
+ Y =< ?MAX_CHAR -> t_char();
+ X >= 1 -> ?integer_pos;
+ X >= 0 -> ?integer_non_neg
+ end
+ end
+ end;
+t_from_range(pos_inf, neg_inf) -> t_none().
+
+-endif.
+
+-spec t_from_range_unsafe(rng_elem(), rng_elem()) -> erl_type().
+
+t_from_range_unsafe(pos_inf, pos_inf) -> ?integer_pos;
+t_from_range_unsafe(neg_inf, neg_inf) -> ?integer_neg;
+t_from_range_unsafe(neg_inf, pos_inf) -> t_integer();
+t_from_range_unsafe(neg_inf, Y) -> ?int_range(neg_inf, Y);
+t_from_range_unsafe(X, pos_inf) -> ?int_range(X, pos_inf);
+t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y), X =< Y ->
+ if (Y - X) < ?SET_LIMIT -> t_integers(lists:seq(X, Y));
+ true -> ?int_range(X, Y)
+ end;
+t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y) -> t_none();
+t_from_range_unsafe(pos_inf, neg_inf) -> t_none().
+
+-spec t_is_fixnum(erl_type()) -> boolean().
+
+t_is_fixnum(?int_range(neg_inf, _)) -> false;
+t_is_fixnum(?int_range(_, pos_inf)) -> false;
+t_is_fixnum(?int_range(From, To)) ->
+ is_fixnum(From) andalso is_fixnum(To);
+t_is_fixnum(?int_set(Set)) ->
+ is_fixnum(set_min(Set)) andalso is_fixnum(set_max(Set));
+t_is_fixnum(_) -> false.
+
+-spec is_fixnum(integer()) -> boolean().
+
+is_fixnum(N) when is_integer(N) ->
+ Bits = ?BITS,
+ (N =< ((1 bsl (Bits - 1)) - 1)) andalso (N >= -(1 bsl (Bits - 1))).
+
+infinity_geq(pos_inf, _) -> true;
+infinity_geq(_, pos_inf) -> false;
+infinity_geq(_, neg_inf) -> true;
+infinity_geq(neg_inf, _) -> false;
+infinity_geq(A, B) -> A >= B.
+
+-spec t_is_bitwidth(erl_type()) -> boolean().
+
+t_is_bitwidth(?int_range(neg_inf, _)) -> false;
+t_is_bitwidth(?int_range(_, pos_inf)) -> false;
+t_is_bitwidth(?int_range(From, To)) ->
+ infinity_geq(From, 0) andalso infinity_geq(?BITS, To);
+t_is_bitwidth(?int_set(Set)) ->
+ infinity_geq(set_min(Set), 0) andalso infinity_geq(?BITS, set_max(Set));
+t_is_bitwidth(_) -> false.
+
+-spec number_min(erl_type()) -> rng_elem().
+
+number_min(Type) ->
+ number_min(Type, 'universe').
+
+-spec number_min(erl_type(), opaques()) -> rng_elem().
+
+number_min(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun number_min2/1).
+
+number_min2(?int_range(From, _)) -> From;
+number_min2(?int_set(Set)) -> set_min(Set);
+number_min2(?number(?any, _Tag)) -> neg_inf.
+
+-spec number_max(erl_type()) -> rng_elem().
+
+number_max(Type) ->
+ number_max(Type, 'universe').
+
+-spec number_max(erl_type(), opaques()) -> rng_elem().
+
+number_max(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun number_max2/1).
+
+number_max2(?int_range(_, To)) -> To;
+number_max2(?int_set(Set)) -> set_max(Set);
+number_max2(?number(?any, _Tag)) -> pos_inf.
+
+%% -spec int_range(rgn_elem(), rng_elem()) -> erl_type().
+%%
+%% int_range(neg_inf, pos_inf) -> t_integer();
+%% int_range(neg_inf, To) -> ?int_range(neg_inf, To);
+%% int_range(From, pos_inf) -> ?int_range(From, pos_inf);
+%% int_range(From, To) when From =< To -> t_from_range(From, To);
+%% int_range(From, To) when To < From -> ?none.
+
+in_range(_, ?int_range(neg_inf, pos_inf)) -> true;
+in_range(X, ?int_range(From, pos_inf)) -> X >= From;
+in_range(X, ?int_range(neg_inf, To)) -> X =< To;
+in_range(X, ?int_range(From, To)) -> (X >= From) andalso (X =< To).
+
+-spec min(rng_elem(), rng_elem()) -> rng_elem().
+
+min(neg_inf, _) -> neg_inf;
+min(_, neg_inf) -> neg_inf;
+min(pos_inf, Y) -> Y;
+min(X, pos_inf) -> X;
+min(X, Y) when X =< Y -> X;
+min(_, Y) -> Y.
+
+-spec max(rng_elem(), rng_elem()) -> rng_elem().
+
+max(neg_inf, Y) -> Y;
+max(X, neg_inf) -> X;
+max(pos_inf, _) -> pos_inf;
+max(_, pos_inf) -> pos_inf;
+max(X, Y) when X =< Y -> Y;
+max(X, _) -> X.
+
+expand_range_from_set(Range = ?int_range(From, To), Set) ->
+ Min = min(set_min(Set), From),
+ Max = max(set_max(Set), To),
+ if From =:= Min, To =:= Max -> Range;
+ true -> t_from_range(Min, Max)
+ end.
+
+%%=============================================================================
+%%
+%% Lattice operations
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Supremum
+%%
+
+-spec t_sup([erl_type()]) -> erl_type().
+
+t_sup([]) -> ?none;
+t_sup(Ts) ->
+ case lists:any(fun is_any/1, Ts) of
+ true -> ?any;
+ false ->
+ t_sup1(Ts, [])
+ end.
+
+t_sup1([H1, H2|T], L) ->
+ t_sup1(T, [t_sup(H1, H2)|L]);
+t_sup1([T], []) -> subst_all_vars_to_any(T);
+t_sup1(Ts, L) ->
+ t_sup1(Ts++L, []).
+
+-spec t_sup(erl_type(), erl_type()) -> erl_type().
+
+t_sup(?any, _) -> ?any;
+t_sup(_, ?any) -> ?any;
+t_sup(?none, T) -> T;
+t_sup(T, ?none) -> T;
+t_sup(?unit, T) -> T;
+t_sup(T, ?unit) -> T;
+t_sup(T, T) -> subst_all_vars_to_any(T);
+t_sup(?var(_), _) -> ?any;
+t_sup(_, ?var(_)) -> ?any;
+t_sup(?atom(Set1), ?atom(Set2)) ->
+ ?atom(set_union(Set1, Set2));
+t_sup(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(gcd(gcd(U1, U2), abs(B1-B2)), lists:min([B1, B2]));
+t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
+ %% The domain is either a product or any.
+ ?function(t_sup(Domain1, Domain2), t_sup(Range1, Range2));
+t_sup(?identifier(Set1), ?identifier(Set2)) ->
+ ?identifier(set_union(Set1, Set2));
+t_sup(?opaque(Set1), ?opaque(Set2)) ->
+ sup_opaque(set_to_list(ordsets:union(Set1, Set2)));
+%%Disallow unions with opaque types
+%%t_sup(T1=?opaque(_,_,_), T2) ->
+%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
+%%t_sup(T1, T2=?opaque(_,_,_)) ->
+%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none;
+t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) ->
+ ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2));
+t_sup(?nil, ?nil) -> ?nil;
+t_sup(?nil, ?list(Contents, Termination, _)) ->
+ ?list(Contents, t_sup(?nil, Termination), ?unknown_qual);
+t_sup(?list(Contents, Termination, _), ?nil) ->
+ ?list(Contents, t_sup(?nil, Termination), ?unknown_qual);
+t_sup(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2)) ->
+ NewSize =
+ case {Size1, Size2} of
+ {?unknown_qual, ?unknown_qual} -> ?unknown_qual;
+ {?unknown_qual, ?nonempty_qual} -> ?unknown_qual;
+ {?nonempty_qual, ?unknown_qual} -> ?unknown_qual;
+ {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual
+ end,
+ NewContents = t_sup(Contents1, Contents2),
+ NewTermination = t_sup(Termination1, Termination2),
+ TmpList = t_cons(NewContents, NewTermination),
+ case NewSize of
+ ?nonempty_qual -> TmpList;
+ ?unknown_qual ->
+ ?list(FinalContents, FinalTermination, _) = TmpList,
+ ?list(FinalContents, FinalTermination, ?unknown_qual)
+ end;
+t_sup(?number(_, _), ?number(?any, ?unknown_qual) = T) -> T;
+t_sup(?number(?any, ?unknown_qual) = T, ?number(_, _)) -> T;
+t_sup(?float, ?float) -> ?float;
+t_sup(?float, ?integer(_)) -> t_number();
+t_sup(?integer(_), ?float) -> t_number();
+t_sup(?integer(?any) = T, ?integer(_)) -> T;
+t_sup(?integer(_), ?integer(?any) = T) -> T;
+t_sup(?int_set(Set1), ?int_set(Set2)) ->
+ case set_union(Set1, Set2) of
+ ?any ->
+ t_from_range(min(set_min(Set1), set_min(Set2)),
+ max(set_max(Set1), set_max(Set2)));
+ Set -> ?int_set(Set)
+ end;
+t_sup(?int_range(From1, To1), ?int_range(From2, To2)) ->
+ t_from_range(min(From1, From2), max(To1, To2));
+t_sup(Range = ?int_range(_, _), ?int_set(Set)) ->
+ expand_range_from_set(Range, Set);
+t_sup(?int_set(Set), Range = ?int_range(_, _)) ->
+ expand_range_from_set(Range, Set);
+t_sup(?product(Types1), ?product(Types2)) ->
+ L1 = length(Types1),
+ L2 = length(Types2),
+ if L1 =:= L2 -> ?product(t_sup_lists(Types1, Types2));
+ true -> ?any
+ end;
+t_sup(?product(_), _) ->
+ ?any;
+t_sup(_, ?product(_)) ->
+ ?any;
+t_sup(?tuple(?any, ?any, ?any) = T, ?tuple(_, _, _)) -> T;
+t_sup(?tuple(_, _, _), ?tuple(?any, ?any, ?any) = T) -> T;
+t_sup(?tuple(?any, ?any, ?any) = T, ?tuple_set(_)) -> T;
+t_sup(?tuple_set(_), ?tuple(?any, ?any, ?any) = T) -> T;
+t_sup(?tuple(Elements1, Arity, Tag1) = T1,
+ ?tuple(Elements2, Arity, Tag2) = T2) ->
+ if Tag1 =:= Tag2 -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag1 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag2 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2));
+ Tag1 < Tag2 -> ?tuple_set([{Arity, [T1, T2]}]);
+ Tag1 > Tag2 -> ?tuple_set([{Arity, [T2, T1]}])
+ end;
+t_sup(?tuple(_, Arity1, _) = T1, ?tuple(_, Arity2, _) = T2) ->
+ sup_tuple_sets([{Arity1, [T1]}], [{Arity2, [T2]}]);
+t_sup(?tuple_set(List1), ?tuple_set(List2)) ->
+ sup_tuple_sets(List1, List2);
+t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) ->
+ sup_tuple_sets(List1, [{Arity, [T2]}]);
+t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) ->
+ sup_tuple_sets([{Arity, [T1]}], List2);
+t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) ->
+ Pairs =
+ map_pairwise_merge(
+ fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)};
+ (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)}
+ end, A, B),
+ t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV));
+t_sup(T1, T2) ->
+ ?union(U1) = force_union(T1),
+ ?union(U2) = force_union(T2),
+ sup_union(U1, U2).
+
+sup_opaque([]) -> ?none;
+sup_opaque(List) ->
+ L = sup_opaq(List),
+ ?opaque(ordsets:from_list(L)).
+
+sup_opaq(L0) ->
+ L1 = [{{Mod,Name,Args}, T} ||
+ #opaque{mod = Mod, name = Name, args = Args}=T <- L0],
+ F = family(L1),
+ [supl(Ts) || {_, Ts} <- F].
+
+supl([O]) -> O;
+supl(Ts) -> supl(Ts, t_none()).
+
+supl([#opaque{struct = S}=O|L], S0) ->
+ S1 = t_sup(S, S0),
+ case L =:= [] of
+ true -> O#opaque{struct = S1};
+ false -> supl(L, S1)
+ end.
+
+-spec t_sup_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_sup_lists([T1|Left1], [T2|Left2]) ->
+ [t_sup(T1, T2)|t_sup_lists(Left1, Left2)];
+t_sup_lists([], []) ->
+ [].
+
+sup_tuple_sets(L1, L2) ->
+ TotalArities = ordsets:union([Arity || {Arity, _} <- L1],
+ [Arity || {Arity, _} <- L2]),
+ if length(TotalArities) > ?TUPLE_ARITY_LIMIT -> t_tuple();
+ true ->
+ case sup_tuple_sets(L1, L2, []) of
+ [{_Arity, [OneTuple = ?tuple(_, _, _)]}] -> OneTuple;
+ List -> ?tuple_set(List)
+ end
+ end.
+
+sup_tuple_sets([{Arity, Tuples1}|Left1], [{Arity, Tuples2}|Left2], Acc) ->
+ NewAcc = [{Arity, sup_tuples_in_set(Tuples1, Tuples2)}|Acc],
+ sup_tuple_sets(Left1, Left2, NewAcc);
+sup_tuple_sets([{Arity1, _} = T1|Left1] = L1,
+ [{Arity2, _} = T2|Left2] = L2, Acc) ->
+ if Arity1 < Arity2 -> sup_tuple_sets(Left1, L2, [T1|Acc]);
+ Arity1 > Arity2 -> sup_tuple_sets(L1, Left2, [T2|Acc])
+ end;
+sup_tuple_sets([], L2, Acc) -> lists:reverse(Acc, L2);
+sup_tuple_sets(L1, [], Acc) -> lists:reverse(Acc, L1).
+
+sup_tuples_in_set([?tuple(_, _, ?any) = T], L) ->
+ [t_tuple(sup_tuple_elements([T|L]))];
+sup_tuples_in_set(L, [?tuple(_, _, ?any) = T]) ->
+ [t_tuple(sup_tuple_elements([T|L]))];
+sup_tuples_in_set(L1, L2) ->
+ FoldFun = fun(?tuple(_, _, Tag), AccTag) -> t_sup(Tag, AccTag) end,
+ TotalTag0 = lists:foldl(FoldFun, ?none, L1),
+ TotalTag = lists:foldl(FoldFun, TotalTag0, L2),
+ case TotalTag of
+ ?atom(?any) ->
+ %% We will reach the set limit. Widen now.
+ [t_tuple(sup_tuple_elements(L1 ++ L2))];
+ ?atom(Set) ->
+ case set_size(Set) > ?TUPLE_TAG_LIMIT of
+ true ->
+ %% We will reach the set limit. Widen now.
+ [t_tuple(sup_tuple_elements(L1 ++ L2))];
+ false ->
+ %% We can go on and build the tuple set.
+ sup_tuples_in_set(L1, L2, [])
+ end
+ end.
+
+sup_tuple_elements([?tuple(Elements, _, _)|L]) ->
+ lists:foldl(fun (?tuple(Es, _, _), Acc) -> t_sup_lists(Es, Acc) end,
+ Elements, L).
+
+sup_tuples_in_set([?tuple(Elements1, Arity, Tag1) = T1|Left1] = L1,
+ [?tuple(Elements2, Arity, Tag2) = T2|Left2] = L2, Acc) ->
+ if
+ Tag1 < Tag2 -> sup_tuples_in_set(Left1, L2, [T1|Acc]);
+ Tag1 > Tag2 -> sup_tuples_in_set(L1, Left2, [T2|Acc]);
+ Tag2 =:= Tag2 -> NewElements = t_sup_lists(Elements1, Elements2),
+ NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc],
+ sup_tuples_in_set(Left1, Left2, NewAcc)
+ end;
+sup_tuples_in_set([], L2, Acc) -> lists:reverse(Acc, L2);
+sup_tuples_in_set(L1, [], Acc) -> lists:reverse(Acc, L1).
+
+sup_union(U1, U2) ->
+ sup_union(U1, U2, 0, []).
+
+sup_union([?none|Left1], [?none|Left2], N, Acc) ->
+ sup_union(Left1, Left2, N, [?none|Acc]);
+sup_union([T1|Left1], [T2|Left2], N, Acc) ->
+ sup_union(Left1, Left2, N+1, [t_sup(T1, T2)|Acc]);
+sup_union([], [], N, Acc) ->
+ if N =:= 0 -> ?none;
+ N =:= 1 ->
+ [Type] = [T || T <- Acc, T =/= ?none],
+ Type;
+ N =:= length(Acc) -> ?any;
+ true -> ?union(lists:reverse(Acc))
+ end.
+
+force_union(T = ?atom(_)) -> ?atom_union(T);
+force_union(T = ?bitstr(_, _)) -> ?bitstr_union(T);
+force_union(T = ?function(_, _)) -> ?function_union(T);
+force_union(T = ?identifier(_)) -> ?identifier_union(T);
+force_union(T = ?list(_, _, _)) -> ?list_union(T);
+force_union(T = ?nil) -> ?list_union(T);
+force_union(T = ?number(_, _)) -> ?number_union(T);
+force_union(T = ?opaque(_)) -> ?opaque_union(T);
+force_union(T = ?map(_,_,_)) -> ?map_union(T);
+force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T);
+force_union(T = ?tuple_set(_)) -> ?tuple_union(T);
+force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T);
+force_union(T = ?union(_)) -> T.
+
+%%-----------------------------------------------------------------------------
+%% An attempt to write the inverse operation of t_sup/1 -- XXX: INCOMPLETE !!
+%%
+
+-spec t_elements(erl_type()) -> [erl_type()].
+
+t_elements(?none) -> [];
+t_elements(?unit) -> [];
+t_elements(?any = T) -> [T];
+t_elements(?nil = T) -> [T];
+t_elements(?atom(?any) = T) -> [T];
+t_elements(?atom(Atoms)) ->
+ [t_atom(A) || A <- Atoms];
+t_elements(?bitstr(_, _) = T) -> [T];
+t_elements(?function(_, _) = T) -> [T];
+t_elements(?identifier(?any) = T) -> [T];
+t_elements(?identifier(IDs)) ->
+ [?identifier([T]) || T <- IDs];
+t_elements(?list(_, _, _) = T) -> [T];
+t_elements(?number(_, _) = T) ->
+ case T of
+ ?number(?any, ?unknown_qual) ->
+ [?float, ?integer(?any)];
+ ?float -> [T];
+ ?integer(?any) -> [T];
+ ?int_range(_, _) -> [T];
+ ?int_set(Set) ->
+ [t_integer(I) || I <- Set]
+ end;
+t_elements(?opaque(_) = T) ->
+ do_elements(T);
+t_elements(?map(_,_,_) = T) -> [T];
+t_elements(?tuple(_, _, _) = T) -> [T];
+t_elements(?tuple_set(_) = TS) ->
+ case t_tuple_subtypes(TS) of
+ unknown -> [];
+ Elems -> Elems
+ end;
+t_elements(?union(_) = T) ->
+ do_elements(T);
+t_elements(?var(_)) -> [?any]. %% yes, vars exist -- what else to do here?
+%% t_elements(T) ->
+%% io:format("T_ELEMENTS => ~p\n", [T]).
+
+do_elements(Type0) ->
+ case do_opaque(Type0, 'universe', fun(T) -> T end) of
+ ?union(List) -> lists:append([t_elements(T) || T <- List]);
+ Type -> t_elements(Type)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Infimum
+%%
+
+-spec t_inf([erl_type()]) -> erl_type().
+
+t_inf([H1, H2|T]) ->
+ case t_inf(H1, H2) of
+ ?none -> ?none;
+ NewH -> t_inf([NewH|T])
+ end;
+t_inf([H]) -> H;
+t_inf([]) -> ?none.
+
+-spec t_inf(erl_type(), erl_type()) -> erl_type().
+
+t_inf(T1, T2) ->
+ t_inf(T1, T2, 'universe').
+
+%% 'match' should be used from t_find_unknown_opaque() only
+-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}.
+
+-spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type().
+
+t_inf(?var(_), ?var(_), _Opaques) -> ?any;
+t_inf(?var(_), T, _Opaques) -> subst_all_vars_to_any(T);
+t_inf(T, ?var(_), _Opaques) -> subst_all_vars_to_any(T);
+t_inf(?any, T, _Opaques) -> subst_all_vars_to_any(T);
+t_inf(T, ?any, _Opaques) -> subst_all_vars_to_any(T);
+t_inf(?none, _, _Opaques) -> ?none;
+t_inf(_, ?none, _Opaques) -> ?none;
+t_inf(?unit, _, _Opaques) -> ?unit; % ?unit cases should appear below ?none
+t_inf(_, ?unit, _Opaques) -> ?unit;
+t_inf(T, T, _Opaques) -> subst_all_vars_to_any(T);
+t_inf(?atom(Set1), ?atom(Set2), _) ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ NewSet -> ?atom(NewSet)
+ end;
+t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Opaques) ->
+ if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2);
+ true -> ?none
+ end;
+t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Opaques) ->
+ if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1);
+ true -> ?none
+ end;
+t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Opaques) ->
+ t_bitstr(U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) when U2 > U1 ->
+ inf_bitstr(U2, B2, U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) ->
+ inf_bitstr(U1, B1, U2, B2);
+t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Opaques) ->
+ case t_inf(Domain1, Domain2, Opaques) of
+ ?none -> ?none;
+ Domain -> ?function(Domain, t_inf(Range1, Range2, Opaques))
+ end;
+t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?identifier(Set)
+ end;
+t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) ->
+ %% Because it simplifies the anonymous function, we allow Pairs to temporarily
+ %% contain mandatory pairs with none values, since all such cases should
+ %% result in a none result.
+ Pairs =
+ map_pairwise_merge(
+ %% For optional keys in both maps, when the infinimum is none, we have
+ %% essentially concluded that K must not be a key in the map.
+ fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)};
+ %% When a key is optional in one map, but mandatory in another, it
+ %% becomes mandatory in the infinumum
+ (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)}
+ end, A, B),
+ t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV));
+t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) ->
+ ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2));
+t_inf(?nil, ?nil, _Opaques) -> ?nil;
+t_inf(?nil, ?nonempty_list(_, _), _Opaques) ->
+ ?none;
+t_inf(?nonempty_list(_, _), ?nil, _Opaques) ->
+ ?none;
+t_inf(?nil, ?list(_Contents, Termination, _), Opaques) ->
+ t_inf(?nil, t_unopaque(Termination), Opaques);
+t_inf(?list(_Contents, Termination, _), ?nil, Opaques) ->
+ t_inf(?nil, t_unopaque(Termination), Opaques);
+t_inf(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2), Opaques) ->
+ case t_inf(Termination1, Termination2, Opaques) of
+ ?none -> ?none;
+ Termination ->
+ case t_inf(Contents1, Contents2, Opaques) of
+ ?none ->
+ %% If none of the lists are nonempty, then the infimum is nil.
+ case (Size1 =:= ?unknown_qual) andalso (Size2 =:= ?unknown_qual) of
+ true -> t_nil();
+ false -> ?none
+ end;
+ Contents ->
+ Size =
+ case {Size1, Size2} of
+ {?unknown_qual, ?unknown_qual} -> ?unknown_qual;
+ {?unknown_qual, ?nonempty_qual} -> ?nonempty_qual;
+ {?nonempty_qual, ?unknown_qual} -> ?nonempty_qual;
+ {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual
+ end,
+ ?list(Contents, Termination, Size)
+ end
+ end;
+t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) ->
+ case {T1, T2} of
+ {T, T} -> T;
+ {_, ?number(?any, ?unknown_qual)} -> T1;
+ {?number(?any, ?unknown_qual), _} -> T2;
+ {?float, ?integer(_)} -> ?none;
+ {?integer(_), ?float} -> ?none;
+ {?integer(?any), ?integer(_)} -> T2;
+ {?integer(_), ?integer(?any)} -> T1;
+ {?int_set(Set1), ?int_set(Set2)} ->
+ case set_intersection(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?int_set(Set)
+ end;
+ {?int_range(From1, To1), ?int_range(From2, To2)} ->
+ t_from_range(max(From1, From2), min(To1, To2));
+ {Range = ?int_range(_, _), ?int_set(Set)} ->
+ %% io:format("t_inf range, set args ~p ~p ~n", [T1, T2]),
+ Ans2 =
+ case set_filter(fun(X) -> in_range(X, Range) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end,
+ %% io:format("Ans2 ~p ~n", [Ans2]),
+ Ans2;
+ {?int_set(Set), ?int_range(_, _) = Range} ->
+ case set_filter(fun(X) -> in_range(X, Range) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end
+ end;
+t_inf(?product(Types1), ?product(Types2), Opaques) ->
+ L1 = length(Types1),
+ L2 = length(Types2),
+ if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Opaques));
+ true -> ?none
+ end;
+t_inf(?product(_), _, _Opaques) ->
+ ?none;
+t_inf(_, ?product(_), _Opaques) ->
+ ?none;
+t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Opaques) ->
+ subst_all_vars_to_any(T);
+t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Opaques) ->
+ subst_all_vars_to_any(T);
+t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Opaques) ->
+ subst_all_vars_to_any(T);
+t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Opaques) ->
+ subst_all_vars_to_any(T);
+t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Opaques) ->
+ case t_inf_lists_strict(Elements1, Elements2, Opaques) of
+ bottom -> ?none;
+ NewElements -> t_tuple(NewElements)
+ end;
+t_inf(?tuple_set(List1), ?tuple_set(List2), Opaques) ->
+ inf_tuple_sets(List1, List2, Opaques);
+t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) ->
+ inf_tuple_sets(List, [{Arity, [T]}], Opaques);
+t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Opaques) ->
+ inf_tuple_sets(List, [{Arity, [T]}], Opaques);
+%% be careful: here and in the next clause T can be ?opaque
+t_inf(?union(U1), T, Opaques) ->
+ ?union(U2) = force_union(T),
+ inf_union(U1, U2, Opaques);
+t_inf(T, ?union(U2), Opaques) ->
+ ?union(U1) = force_union(T),
+ inf_union(U1, U2, Opaques);
+t_inf(?opaque(Set1), ?opaque(Set2), Opaques) ->
+ inf_opaque(Set1, Set2, Opaques);
+t_inf(?opaque(_) = T1, T2, Opaques) ->
+ inf_opaque1(T2, T1, 1, Opaques);
+t_inf(T1, ?opaque(_) = T2, Opaques) ->
+ inf_opaque1(T1, T2, 2, Opaques);
+%% and as a result, the cases for ?opaque should appear *after* ?union
+t_inf(#c{}, #c{}, _) ->
+ ?none.
+
+inf_opaque1(T1, ?opaque(Set2)=T2, Pos, Opaques) ->
+ case Opaques =:= 'universe' orelse inf_is_opaque_type(T2, Pos, Opaques) of
+ false -> ?none;
+ true ->
+ List2 = set_to_list(Set2),
+ case inf_collect(T1, List2, Opaques, []) of
+ [] -> ?none;
+ OpL -> ?opaque(ordsets:from_list(OpL))
+ end
+ end.
+
+inf_is_opaque_type(T, Pos, {match, Opaques}) ->
+ is_opaque_type(T, Opaques) orelse throw({pos, [Pos]});
+inf_is_opaque_type(T, _Pos, Opaques) ->
+ is_opaque_type(T, Opaques).
+
+inf_collect(T1, [T2|List2], Opaques, OpL) ->
+ #opaque{struct = S2} = T2,
+ case t_inf(T1, S2, Opaques) of
+ ?none -> inf_collect(T1, List2, Opaques, OpL);
+ Inf ->
+ Op = T2#opaque{struct = Inf},
+ inf_collect(T1, List2, Opaques, [Op|OpL])
+ end;
+inf_collect(_T1, [], _Opaques, OpL) ->
+ OpL.
+
+combine(S, T1, T2) ->
+ case is_compat_opaque_names(T1, T2) of
+ true -> combine(S, [T1]);
+ false -> combine(S, [T1, T2])
+ end.
+
+combine(?opaque(Set), Ts) ->
+ [comb2(O, T) || O <- Set, T <- Ts];
+combine(S, Ts) ->
+ [T#opaque{struct = S} || T <- Ts].
+
+comb2(O, T) ->
+ case is_compat_opaque_names(O, T) of
+ true -> O;
+ false -> T#opaque{struct = ?opaque(set_singleton(O))}
+ end.
+
+%% Combining two lists this way can be very time consuming...
+%% Note: two parameterized opaque types are not the same if their
+%% actual parameters differ
+inf_opaque(Set1, Set2, Opaques) ->
+ List1 = inf_look_up(Set1, Opaques),
+ List2 = inf_look_up(Set2, Opaques),
+ List0 = [combine(Inf, T1, T2) ||
+ {Is1, T1} <- List1,
+ {Is2, T2} <- List2,
+ not t_is_none(Inf = inf_opaque_types(Is1, T1, Is2, T2, Opaques))],
+ List = lists:append(List0),
+ sup_opaque(List).
+
+%% Optimization: do just one lookup.
+inf_look_up(Set, Opaques) ->
+ [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Opaques), T} ||
+ T <- set_to_list(Set)].
+
+inf_is_opaque_type2(T, {match, Opaques}) ->
+ is_opaque_type2(T, Opaques);
+inf_is_opaque_type2(T, Opaques) ->
+ is_opaque_type2(T, Opaques).
+
+inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) ->
+ #opaque{struct = S1}=T1,
+ #opaque{struct = S2}=T2,
+ case
+ Opaques =:= 'universe' orelse is_compat_opaque_names(T1, T2)
+ of
+ true -> t_inf(S1, S2, Opaques);
+ false ->
+ case {IsOpaque1, IsOpaque2} of
+ {true, true} -> t_inf(S1, S2, Opaques);
+ {true, false} -> t_inf(S1, ?opaque(set_singleton(T2)), Opaques);
+ {false, true} -> t_inf(?opaque(set_singleton(T1)), S2, Opaques);
+ {false, false} when element(1, Opaques) =:= match ->
+ throw({pos, [1, 2]});
+ {false, false} -> t_none()
+ end
+ end.
+
+compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) ->
+ [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)].
+
+is_compat_opaque_names(Opaque1, Opaque2) ->
+ #opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1,
+ #opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2,
+ case {{Mod1, Name1, Args1}, {Mod2, Name2, Args2}} of
+ {ModNameArgs, ModNameArgs} -> true;
+ {{Mod, Name, Args1}, {Mod, Name, Args2}} ->
+ is_compat_args(Args1, Args2);
+ _ -> false
+ end.
+
+is_compat_args([A1|Args1], [A2|Args2]) ->
+ is_compat_arg(A1, A2) andalso is_compat_args(Args1, Args2);
+is_compat_args([], []) -> true;
+is_compat_args(_, _) -> false.
+
+-spec is_compat_arg(erl_type(), erl_type()) -> boolean().
+
+%% The intention is that 'true' is to be returned iff one of the
+%% arguments is a specialization of the other argument in the sense
+%% that every type is a specialization of any(). For example, {_,_} is
+%% a specialization of any(), but not of tuple(). Does not handle
+%% variables, but any() and unions (sort of). However, the
+%% implementation is more relaxed as any() is compatible to anything.
+
+is_compat_arg(T, T) -> true;
+is_compat_arg(_, ?any) -> true;
+is_compat_arg(?any, _) -> true;
+is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) ->
+ (is_compat_arg(Domain1, Domain2) andalso
+ is_compat_arg(Range1, Range2));
+is_compat_arg(?list(Contents1, Termination1, Size1),
+ ?list(Contents2, Termination2, Size2)) ->
+ (Size1 =:= Size2 andalso
+ is_compat_arg(Contents1, Contents2) andalso
+ is_compat_arg(Termination1, Termination2));
+is_compat_arg(?product(Types1), ?product(Types2)) ->
+ is_compat_list(Types1, Types2);
+is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) ->
+ {Ks1, _, Vs1} = lists:unzip3(Pairs1),
+ {Ks2, _, Vs2} = lists:unzip3(Pairs2),
+ Key1 = t_sup([DefK1 | Ks1]),
+ Key2 = t_sup([DefK2 | Ks2]),
+ case is_compat_arg(Key1, Key2) of
+ true ->
+ Value1 = t_sup([DefV1 | Vs1]),
+ Value2 = t_sup([DefV2 | Vs2]),
+ is_compat_arg(Value1, Value2);
+ false ->
+ false
+ end;
+is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
+is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(Elements1, Elements2);
+is_compat_arg(?tuple_set([{Arity, List}]),
+ ?tuple(Elements2, Arity, _)) when Arity =/= ?any ->
+ is_compat_list(sup_tuple_elements(List), Elements2);
+is_compat_arg(?tuple(Elements1, Arity, _),
+ ?tuple_set([{Arity, List}])) when Arity =/= ?any ->
+ is_compat_list(Elements1, sup_tuple_elements(List));
+is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) ->
+ try
+ is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1],
+ [sup_tuple_elements(T) || {_Arity, T} <- List2])
+ catch _:_ -> false
+ end;
+is_compat_arg(?opaque(_) = T1, T2) ->
+ is_compat_arg(t_opaque_structure(T1), T2);
+is_compat_arg(T1, ?opaque(_) = T2) ->
+ is_compat_arg(T1, t_opaque_structure(T2));
+is_compat_arg(?union(List1)=T1, ?union(List2)=T2) ->
+ case is_compat_union2(T1, T2) of
+ {yes, Type1, Type2} -> is_compat_arg(Type1, Type2);
+ no -> is_compat_list(List1, List2)
+ end;
+is_compat_arg(?union(List), T2) ->
+ case unify_union(List) of
+ {yes, Type} -> is_compat_arg(Type, T2);
+ no -> false
+ end;
+is_compat_arg(T1, ?union(List)) ->
+ case unify_union(List) of
+ {yes, Type} -> is_compat_arg(T1, Type);
+ no -> false
+ end;
+is_compat_arg(?var(_), _) -> exit(error);
+is_compat_arg(_, ?var(_)) -> exit(error);
+is_compat_arg(?none, _) -> false;
+is_compat_arg(_, ?none) -> false;
+is_compat_arg(?unit, _) -> false;
+is_compat_arg(_, ?unit) -> false;
+is_compat_arg(#c{}, #c{}) -> false.
+
+is_compat_list_list(LL1, LL2) ->
+ length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2).
+
+is_compat_list_list1([], []) -> true;
+is_compat_list_list1([L1|LL1], [L2|LL2]) ->
+ is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2).
+
+is_compat_list(L1, L2) ->
+ length(L1) =:= length(L2) andalso is_compat_list1(L1, L2).
+
+is_compat_list1([], []) -> true;
+is_compat_list1([T1|L1], [T2|L2]) ->
+ is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2).
+
+is_compat_union2(?union(List1)=T1, ?union(List2)=T2) ->
+ case {unify_union(List1), unify_union(List2)} of
+ {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2};
+ {{yes, Type1}, no} -> {yes, Type1, T2};
+ {no, {yes, Type2}} -> {yes, T1, Type2};
+ {no, no} -> no
+ end.
+
+-spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_inf_lists(L1, L2) ->
+ t_inf_lists(L1, L2, 'universe').
+
+-spec t_inf_lists([erl_type()], [erl_type()], t_inf_opaques()) -> [erl_type()].
+
+t_inf_lists(L1, L2, Opaques) ->
+ t_inf_lists(L1, L2, [], Opaques).
+
+-spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> [erl_type()].
+
+t_inf_lists([T1|Left1], [T2|Left2], Acc, Opaques) ->
+ t_inf_lists(Left1, Left2, [t_inf(T1, T2, Opaques)|Acc], Opaques);
+t_inf_lists([], [], Acc, _Opaques) ->
+ lists:reverse(Acc).
+
+%% Infimum of lists with strictness.
+%% If any element is the ?none type, the value 'bottom' is returned.
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict(L1, L2, Opaques) ->
+ t_inf_lists_strict(L1, L2, [], Opaques).
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Opaques) ->
+ case t_inf(T1, T2, Opaques) of
+ ?none -> bottom;
+ T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Opaques)
+ end;
+t_inf_lists_strict([], [], Acc, _Opaques) ->
+ lists:reverse(Acc).
+
+inf_tuple_sets(L1, L2, Opaques) ->
+ case inf_tuple_sets(L1, L2, [], Opaques) of
+ [] -> ?none;
+ [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple;
+ List -> ?tuple_set(List)
+ end.
+
+inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc, Opaques) ->
+ case inf_tuples_in_sets(Tuples1, Tuples2, Opaques) of
+ [] -> inf_tuple_sets(Ts1, Ts2, Acc, Opaques);
+ [?tuple_set([{Arity, NewTuples}])] ->
+ inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques);
+ NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques)
+ end;
+inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc, Opaques) ->
+ if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Opaques);
+ Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Opaques)
+ end;
+inf_tuple_sets([], _, Acc, _Opaques) -> lists:reverse(Acc);
+inf_tuple_sets(_, [], Acc, _Opaques) -> lists:reverse(Acc).
+
+inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Opaques) ->
+ NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques)
+ || ?tuple(Elements2, _, _) <- L2],
+ [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Opaques) ->
+ NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques)
+ || ?tuple(Elements1, _, _) <- L1],
+ [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, L2, Opaques) ->
+ inf_tuples_in_sets2(L1, L2, [], Opaques).
+
+inf_tuples_in_sets2([?tuple(Elements1, Arity, Tag)|Ts1],
+ [?tuple(Elements2, Arity, Tag)|Ts2], Acc, Opaques) ->
+ case t_inf_lists_strict(Elements1, Elements2, Opaques) of
+ bottom -> inf_tuples_in_sets2(Ts1, Ts2, Acc, Opaques);
+ NewElements ->
+ inf_tuples_in_sets2(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc],
+ Opaques)
+ end;
+inf_tuples_in_sets2([?tuple(_, _, Tag1)|Ts1] = L1,
+ [?tuple(_, _, Tag2)|Ts2] = L2, Acc, Opaques) ->
+ if Tag1 < Tag2 -> inf_tuples_in_sets2(Ts1, L2, Acc, Opaques);
+ Tag1 > Tag2 -> inf_tuples_in_sets2(L1, Ts2, Acc, Opaques)
+ end;
+inf_tuples_in_sets2([], _, Acc, _Opaques) -> lists:reverse(Acc);
+inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc).
+
+inf_union(U1, U2, Opaques) ->
+ OpaqueFun =
+ fun(Union1, Union2, InfFun) ->
+ [_,_,_,_,_,_,_,_,Opaque,_] = Union1,
+ [A,B,F,I,L,N,T,M,_,Map] = Union2,
+ List = [A,B,F,I,L,N,T,M,Map],
+ inf_union_collect(List, Opaque, InfFun, [], [])
+ end,
+ {O1, ThrowList1} =
+ OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end),
+ {O2, ThrowList2}
+ = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end),
+ {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques),
+ ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3),
+ case t_sup([O1, O2, Union]) of
+ ?none when ThrowList =/= [] -> throw({pos, lists:usort(ThrowList)});
+ Sup -> Sup
+ end.
+
+inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) ->
+ {t_sup(InfList), lists:usort(ThrowList)};
+inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) ->
+ inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList);
+inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
+ try InfFun(E, Opaque)of
+ Inf ->
+ inf_union_collect(L, Opaque, InfFun, [Inf|InfList], ThrowList)
+ catch throw:{pos, Ns} ->
+ inf_union_collect(L, Opaque, InfFun, InfList, Ns ++ ThrowList)
+ end.
+
+inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) ->
+ inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) ->
+ try t_inf(T1, T2, Opaques) of
+ ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+ T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques)
+ catch throw:{pos, Ns} ->
+ inf_union(Left1, Left2, N, [?none|Acc], Ns ++ ThrowList, Opaques)
+ end;
+inf_union([], [], N, Acc, ThrowList, _Opaques) ->
+ if N =:= 0 -> {?none, ThrowList};
+ N =:= 1 ->
+ [Type] = [T || T <- Acc, T =/= ?none],
+ {Type, ThrowList};
+ N >= 2 -> {?union(lists:reverse(Acc)), ThrowList}
+ end.
+
+inf_bitstr(U1, B1, U2, B2) ->
+ GCD = gcd(U1, U2),
+ case (B2-B1) rem GCD of
+ 0 ->
+ U = (U1*U2) div GCD,
+ B = findfirst(0, 0, U1, B1, U2, B2),
+ t_bitstr(U, B);
+ _ ->
+ ?none
+ end.
+
+findfirst(N1, N2, U1, B1, U2, B2) ->
+ Val1 = U1*N1+B1,
+ Val2 = U2*N2+B2,
+ if Val1 =:= Val2 ->
+ Val1;
+ Val1 > Val2 ->
+ findfirst(N1, N2+1, U1, B1, U2, B2);
+ Val1 < Val2 ->
+ findfirst(N1+1, N2, U1, B1, U2, B2)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Substitution of variables
+%%
+
+-type subst_table() :: #{any() => erl_type()}.
+
+-spec t_subst(erl_type(), subst_table()) -> erl_type().
+
+t_subst(T, Map) ->
+ case t_has_var(T) of
+ true -> t_subst_aux(T, Map);
+ false -> T
+ end.
+
+-spec subst_all_vars_to_any(erl_type()) -> erl_type().
+
+subst_all_vars_to_any(T) ->
+ t_subst(T, #{}).
+
+t_subst_aux(?var(Id), Map) ->
+ case maps:find(Id, Map) of
+ error -> ?any;
+ {ok, Type} -> Type
+ end;
+t_subst_aux(?list(Contents, Termination, Size), Map) ->
+ case t_subst_aux(Contents, Map) of
+ ?none -> ?none;
+ NewContents ->
+ %% Be careful here to make the termination collapse if necessary.
+ case t_subst_aux(Termination, Map) of
+ ?nil -> ?list(NewContents, ?nil, Size);
+ ?any -> ?list(NewContents, ?any, Size);
+ Other ->
+ ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other),
+ ?list(NewContents2, NewTermination, Size)
+ end
+ end;
+t_subst_aux(?function(Domain, Range), Map) ->
+ ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map));
+t_subst_aux(?product(Types), Map) ->
+ ?product([t_subst_aux(T, Map) || T <- Types]);
+t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) ->
+ T;
+t_subst_aux(?tuple(Elements, _Arity, _Tag), Map) ->
+ t_tuple([t_subst_aux(E, Map) || E <- Elements]);
+t_subst_aux(?tuple_set(_) = TS, Map) ->
+ t_sup([t_subst_aux(T, Map) || T <- t_tuple_subtypes(TS)]);
+t_subst_aux(?map(Pairs, DefK, DefV), Map) ->
+ t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs],
+ t_subst_aux(DefK, Map), t_subst_aux(DefV, Map));
+t_subst_aux(?opaque(Es), Map) ->
+ List = [Opaque#opaque{args = [t_subst_aux(Arg, Map) || Arg <- Args],
+ struct = t_subst_aux(S, Map)} ||
+ Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)],
+ ?opaque(ordsets:from_list(List));
+t_subst_aux(?union(List), Map) ->
+ ?union([t_subst_aux(E, Map) || E <- List]);
+t_subst_aux(T, _Map) ->
+ T.
+
+%%-----------------------------------------------------------------------------
+%% Unification
+%%
+
+-type t_unify_ret() :: {erl_type(), [{_, erl_type()}]}.
+
+-spec t_unify(erl_type(), erl_type()) -> t_unify_ret().
+
+t_unify(T1, T2) ->
+ {T, VarMap} = t_unify(T1, T2, #{}),
+ {t_subst(T, VarMap), lists:keysort(1, maps:to_list(VarMap))}.
+
+t_unify(?var(Id) = T, ?var(Id), VarMap) ->
+ {T, VarMap};
+t_unify(?var(Id1) = T, ?var(Id2), VarMap) ->
+ case maps:find(Id1, VarMap) of
+ error ->
+ case maps:find(Id2, VarMap) of
+ error -> {T, VarMap#{Id2 => T}};
+ {ok, Type} -> t_unify(T, Type, VarMap)
+ end;
+ {ok, Type1} ->
+ case maps:find(Id2, VarMap) of
+ error -> {Type1, VarMap#{Id2 => T}};
+ {ok, Type2} -> t_unify(Type1, Type2, VarMap)
+ end
+ end;
+t_unify(?var(Id), Type, VarMap) ->
+ case maps:find(Id, VarMap) of
+ error -> {Type, VarMap#{Id => Type}};
+ {ok, VarType} -> t_unify(VarType, Type, VarMap)
+ end;
+t_unify(Type, ?var(Id), VarMap) ->
+ case maps:find(Id, VarMap) of
+ error -> {Type, VarMap#{Id => Type}};
+ {ok, VarType} -> t_unify(VarType, Type, VarMap)
+ end;
+t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) ->
+ {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap),
+ {Range, VarMap2} = t_unify(Range1, Range2, VarMap1),
+ {?function(Domain, Range), VarMap2};
+t_unify(?list(Contents1, Termination1, Size),
+ ?list(Contents2, Termination2, Size), VarMap) ->
+ {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap),
+ {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1),
+ {?list(Contents, Termination, Size), VarMap2};
+t_unify(?product(Types1), ?product(Types2), VarMap) ->
+ {Types, VarMap1} = unify_lists(Types1, Types2, VarMap),
+ {?product(Types), VarMap1};
+t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap) ->
+ {T, VarMap};
+t_unify(?tuple(Elements1, Arity, _),
+ ?tuple(Elements2, Arity, _), VarMap) when Arity =/= ?any ->
+ {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap),
+ {t_tuple(NewElements), VarMap1};
+t_unify(?tuple_set([{Arity, _}]) = T1,
+ ?tuple(_, Arity, _) = T2, VarMap) when Arity =/= ?any ->
+ unify_tuple_set_and_tuple1(T1, T2, VarMap);
+t_unify(?tuple(_, Arity, _) = T1,
+ ?tuple_set([{Arity, _}]) = T2, VarMap) when Arity =/= ?any ->
+ unify_tuple_set_and_tuple2(T1, T2, VarMap);
+t_unify(?tuple_set(List1) = T1, ?tuple_set(List2) = T2, VarMap) ->
+ try
+ unify_lists(lists:append([T || {_Arity, T} <- List1]),
+ lists:append([T || {_Arity, T} <- List2]), VarMap)
+ of
+ {Tuples, NewVarMap} -> {t_sup(Tuples), NewVarMap}
+ catch _:_ -> throw({mismatch, T1, T2})
+ end;
+t_unify(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0) ->
+ {DefK, VarMap1} = t_unify(ADefK, BDefK, VarMap0),
+ {DefV, VarMap2} = t_unify(ADefV, BDefV, VarMap1),
+ {Pairs, VarMap} =
+ map_pairwise_merge_foldr(
+ fun(K, MNess, V1, MNess, V2, {Pairs0, VarMap3}) ->
+ %% We know that the keys unify and do not contain variables, or they
+ %% would not be singletons
+ %% TODO: Should V=?none (known missing keys) be handled special?
+ {V, VarMap4} = t_unify(V1, V2, VarMap3),
+ {[{K,MNess,V}|Pairs0], VarMap4};
+ (K, _, V1, _, V2, {Pairs0, VarMap3}) ->
+ %% One mandatory and one optional; what should be done in this case?
+ {V, VarMap4} = t_unify(V1, V2, VarMap3),
+ {[{K,?mand,V}|Pairs0], VarMap4}
+ end, {[], VarMap2}, A, B),
+ {t_map(Pairs, DefK, DefV), VarMap};
+t_unify(?opaque(_) = T1, ?opaque(_) = T2, VarMap) ->
+ t_unify(t_opaque_structure(T1), t_opaque_structure(T2), VarMap);
+t_unify(T1, ?opaque(_) = T2, VarMap) ->
+ t_unify(T1, t_opaque_structure(T2), VarMap);
+t_unify(?opaque(_) = T1, T2, VarMap) ->
+ t_unify(t_opaque_structure(T1), T2, VarMap);
+t_unify(T, T, VarMap) ->
+ {T, VarMap};
+t_unify(?union(_)=T1, ?union(_)=T2, VarMap) ->
+ {Type1, Type2} = unify_union2(T1, T2),
+ t_unify(Type1, Type2, VarMap);
+t_unify(?union(_)=T1, T2, VarMap) ->
+ t_unify(unify_union1(T1, T1, T2), T2, VarMap);
+t_unify(T1, ?union(_)=T2, VarMap) ->
+ t_unify(T1, unify_union1(T2, T1, T2), VarMap);
+t_unify(T1, T2, _) ->
+ throw({mismatch, T1, T2}).
+
+unify_union2(?union(List1)=T1, ?union(List2)=T2) ->
+ case {unify_union(List1), unify_union(List2)} of
+ {{yes, Type1}, {yes, Type2}} -> {Type1, Type2};
+ {{yes, Type1}, no} -> {Type1, T2};
+ {no, {yes, Type2}} -> {T1, Type2};
+ {no, no} -> throw({mismatch, T1, T2})
+ end.
+
+unify_union1(?union(List), T1, T2) ->
+ case unify_union(List) of
+ {yes, Type} -> Type;
+ no -> throw({mismatch, T1, T2})
+ end.
+
+unify_union(List) ->
+ [A,B,F,I,L,N,T,M,O,Map] = List,
+ if O =:= ?none -> no;
+ true ->
+ S = t_opaque_structure(O),
+ {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])}
+ end.
+
+-spec is_opaque_type(erl_type(), [erl_type()]) -> boolean().
+
+%% An opaque type is a union of types. Returns true iff any of the type
+%% names (Module and Name) of the first argument (the opaque type to
+%% check) occurs in any of the opaque types of the second argument.
+is_opaque_type(?opaque(Elements), Opaques) ->
+ lists:any(fun(Opaque) -> is_opaque_type2(Opaque, Opaques) end, Elements).
+
+is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) ->
+ F1 = fun(?opaque(Es)) ->
+ F2 = fun(#opaque{mod = Mod, name = Name, args = Args}) ->
+ is_type_name(Mod1, Name1, Args1, Mod, Name, Args)
+ end,
+ lists:any(F2, Es)
+ end,
+ lists:any(F1, Opaques).
+
+is_type_name(Mod, Name, Args1, Mod, Name, Args2) ->
+ length(Args1) =:= length(Args2);
+is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) ->
+ false.
+
+%% Two functions since t_unify is not symmetric.
+unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]),
+ ?tuple(Elements2, Arity, _), VarMap) ->
+ %% Can only work if the single tuple has variables at correct places.
+ %% Collapse the tuple set.
+ {NewElements, VarMap1} =
+ unify_lists(sup_tuple_elements(List), Elements2, VarMap),
+ {t_tuple(NewElements), VarMap1}.
+
+unify_tuple_set_and_tuple2(?tuple(Elements2, Arity, _),
+ ?tuple_set([{Arity, List}]), VarMap) ->
+ %% Can only work if the single tuple has variables at correct places.
+ %% Collapse the tuple set.
+ {NewElements, VarMap1} =
+ unify_lists(Elements2, sup_tuple_elements(List), VarMap),
+ {t_tuple(NewElements), VarMap1}.
+
+unify_lists(L1, L2, VarMap) ->
+ unify_lists(L1, L2, VarMap, []).
+
+unify_lists([T1|Left1], [T2|Left2], VarMap, Acc) ->
+ {NewT, NewVarMap} = t_unify(T1, T2, VarMap),
+ unify_lists(Left1, Left2, NewVarMap, [NewT|Acc]);
+unify_lists([], [], VarMap, Acc) ->
+ {lists:reverse(Acc), VarMap}.
+
+%%t_assign_variables_to_subtype(T1, T2) ->
+%% try
+%% Dict = assign_vars(T1, T2, dict:new()),
+%% {ok, dict:map(fun(_Param, List) -> t_sup(List) end, Dict)}
+%% catch
+%% throw:error -> error
+%% end.
+
+%%assign_vars(_, ?var(_), _Dict) ->
+%% erlang:error("Variable in right hand side of assignment");
+%%assign_vars(?any, _, Dict) ->
+%% Dict;
+%%assign_vars(?var(_) = Var, Type, Dict) ->
+%% store_var(Var, Type, Dict);
+%%assign_vars(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) ->
+%% DomainList =
+%% case Domain2 of
+%% ?any -> [];
+%% ?product(List) -> List
+%% end,
+%% case any_none([Range2|DomainList]) of
+%% true -> throw(error);
+%% false ->
+%% Dict1 = assign_vars(Domain1, Domain2, Dict),
+%% assign_vars(Range1, Range2, Dict1)
+%% end;
+%%assign_vars(?list(_Contents, _Termination, ?any), ?nil, Dict) ->
+%% Dict;
+%%assign_vars(?list(Contents1, Termination1, Size1),
+%% ?list(Contents2, Termination2, Size2), Dict) ->
+%% Dict1 = assign_vars(Contents1, Contents2, Dict),
+%% Dict2 = assign_vars(Termination1, Termination2, Dict1),
+%% case {Size1, Size2} of
+%% {S, S} -> Dict2;
+%% {?any, ?nonempty_qual} -> Dict2;
+%% {_, _} -> throw(error)
+%% end;
+%%assign_vars(?product(Types1), ?product(Types2), Dict) ->
+%% case length(Types1) =:= length(Types2) of
+%% true -> assign_vars_lists(Types1, Types2, Dict);
+%% false -> throw(error)
+%% end;
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple(?any, ?any, ?any), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple(_, _, _), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(Elements1, Arity, _),
+%% ?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any ->
+%% assign_vars_lists(Elements1, Elements2, Dict);
+%%assign_vars(?tuple_set(_) = T, ?tuple_set(List2), Dict) ->
+%% %% All Rhs tuples must already be subtypes of Lhs, so we can take
+%% %% each one separatly.
+%% assign_vars_lists([T || _ <- List2], List2, Dict);
+%%assign_vars(?tuple(?any, ?any, ?any), ?tuple_set(_), Dict) ->
+%% Dict;
+%%assign_vars(?tuple(_, Arity, _) = T1, ?tuple_set(List), Dict) ->
+%% case reduce_tuple_tags(List) of
+%% [Tuple = ?tuple(_, Arity, _)] -> assign_vars(T1, Tuple, Dict);
+%% _ -> throw(error)
+%% end;
+%%assign_vars(?tuple_set(List), ?tuple(_, Arity, Tag) = T2, Dict) ->
+%% case [T || ?tuple(_, Arity1, Tag1) = T <- List,
+%% Arity1 =:= Arity, Tag1 =:= Tag] of
+%% [] -> throw(error);
+%% [T1] -> assign_vars(T1, T2, Dict)
+%% end;
+%%assign_vars(?union(U1), T2, Dict) ->
+%% ?union(U2) = force_union(T2),
+%% assign_vars_lists(U1, U2, Dict);
+%%assign_vars(T, T, Dict) ->
+%% Dict;
+%%assign_vars(T1, T2, Dict) ->
+%% case t_is_subtype(T2, T1) of
+%% false -> throw(error);
+%% true -> Dict
+%% end.
+
+%%assign_vars_lists([T1|Left1], [T2|Left2], Dict) ->
+%% assign_vars_lists(Left1, Left2, assign_vars(T1, T2, Dict));
+%%assign_vars_lists([], [], Dict) ->
+%% Dict.
+
+%%store_var(?var(Id), Type, Dict) ->
+%% case dict:find(Id, Dict) of
+%% error -> dict:store(Id, [Type], Dict);
+%% {ok, _VarType0} -> dict:update(Id, fun(X) -> [Type|X] end, Dict)
+%% end.
+
+%%-----------------------------------------------------------------------------
+%% Subtraction.
+%%
+%% Note that the subtraction is an approximation since we do not have
+%% negative types. Also, tuples and products should be handled using
+%% the cartesian product of the elements, but this is not feasible to
+%% do.
+%%
+%% Example: {a|b,c|d}\{a,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d} =
+%% = {a,c}|{b,c}|{b,d} = {a|b,c|d}
+%%
+%% Instead, we can subtract if all elements but one becomes none after
+%% subtracting element-wise.
+%%
+%% Example: {a|b,c|d}\{a|b,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d}|{b,d} =
+%% = {a,c}|{b,c} = {a|b,c}
+
+-spec t_subtract_list(erl_type(), [erl_type()]) -> erl_type().
+
+t_subtract_list(T1, [T2|Left]) ->
+ t_subtract_list(t_subtract(T1, T2), Left);
+t_subtract_list(T, []) ->
+ T.
+
+-spec t_subtract(erl_type(), erl_type()) -> erl_type().
+
+t_subtract(_, ?any) -> ?none;
+t_subtract(T, ?var(_)) -> T;
+t_subtract(?any, _) -> ?any;
+t_subtract(?var(_) = T, _) -> T;
+t_subtract(T, ?unit) -> T;
+t_subtract(?unit, _) -> ?unit;
+t_subtract(?none, _) -> ?none;
+t_subtract(T, ?none) -> T;
+t_subtract(?atom(Set1), ?atom(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?atom(Set)
+ end;
+t_subtract(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ subtract_bin(t_bitstr(U1, B1), t_inf(t_bitstr(U1, B1), t_bitstr(U2, B2)));
+t_subtract(?function(_, _) = T1, ?function(_, _) = T2) ->
+ case t_is_subtype(T1, T2) of
+ true -> ?none;
+ false -> T1
+ end;
+t_subtract(?identifier(Set1), ?identifier(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?identifier(Set)
+ end;
+t_subtract(?opaque(_)=T1, ?opaque(_)=T2) ->
+ opaque_subtract(T1, t_opaque_structure(T2));
+t_subtract(?opaque(_)=T1, T2) ->
+ opaque_subtract(T1, T2);
+t_subtract(T1, ?opaque(_)=T2) ->
+ t_subtract(T1, t_opaque_structure(T2));
+t_subtract(?matchstate(Pres1, Slots1), ?matchstate(Pres2, _Slots2)) ->
+ Pres = t_subtract(Pres1, Pres2),
+ case t_is_none(Pres) of
+ true -> ?none;
+ false -> ?matchstate(Pres, Slots1)
+ end;
+t_subtract(?matchstate(Present, Slots), _) ->
+ ?matchstate(Present, Slots);
+t_subtract(?nil, ?nil) ->
+ ?none;
+t_subtract(?nil, ?nonempty_list(_, _)) ->
+ ?nil;
+t_subtract(?nil, ?list(_, _, _)) ->
+ ?none;
+t_subtract(?list(Contents, Termination, _Size) = T, ?nil) ->
+ case Termination =:= ?nil of
+ true -> ?nonempty_list(Contents, Termination);
+ false -> T
+ end;
+t_subtract(?list(Contents1, Termination1, Size1) = T,
+ ?list(Contents2, Termination2, Size2)) ->
+ case t_is_subtype(Contents1, Contents2) of
+ true ->
+ case t_is_subtype(Termination1, Termination2) of
+ true ->
+ case {Size1, Size2} of
+ {?nonempty_qual, ?unknown_qual} -> ?none;
+ {?unknown_qual, ?nonempty_qual} -> ?nil;
+ {S, S} -> ?none
+ end;
+ false ->
+ %% If the termination is not covered by the subtracted type
+ %% we cannot really say anything about the result.
+ T
+ end;
+ false ->
+ %% All contents must be covered if there is going to be any
+ %% change to the list.
+ T
+ end;
+t_subtract(?float, ?float) -> ?none;
+t_subtract(?number(_, _) = T1, ?float) -> t_inf(T1, t_integer());
+t_subtract(?float, ?number(_Set, Tag)) ->
+ case Tag of
+ ?unknown_qual -> ?none;
+ _ -> ?float
+ end;
+t_subtract(?number(_, _), ?number(?any, ?unknown_qual)) -> ?none;
+t_subtract(?number(_, _) = T1, ?integer(?any)) -> t_inf(?float, T1);
+t_subtract(?int_set(Set1), ?int_set(Set2)) ->
+ case set_subtract(Set1, Set2) of
+ ?none -> ?none;
+ Set -> ?int_set(Set)
+ end;
+t_subtract(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) ->
+ case t_inf(T1, T2) of
+ ?none -> T1;
+ ?int_range(From1, To1) -> ?none;
+ ?int_range(neg_inf, To) -> t_from_range(To + 1, To1);
+ ?int_range(From, pos_inf) -> t_from_range(From1, From - 1);
+ ?int_range(From, To) -> t_sup(t_from_range(From1, From - 1),
+ t_from_range(To + 1, To))
+ end;
+t_subtract(?int_range(From, To) = T1, ?int_set(Set)) ->
+ NewFrom = case set_is_element(From, Set) of
+ true -> From + 1;
+ false -> From
+ end,
+ NewTo = case set_is_element(To, Set) of
+ true -> To - 1;
+ false -> To
+ end,
+ if (NewFrom =:= From) and (NewTo =:= To) -> T1;
+ true -> t_from_range(NewFrom, NewTo)
+ end;
+t_subtract(?int_set(Set), ?int_range(From, To)) ->
+ case set_filter(fun(X) -> not ((X =< From) orelse (X >= To)) end, Set) of
+ ?none -> ?none;
+ NewSet -> ?int_set(NewSet)
+ end;
+t_subtract(?integer(?any) = T1, ?integer(_)) -> T1;
+t_subtract(?number(_, _) = T1, ?number(_, _)) -> T1;
+t_subtract(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> ?none;
+t_subtract(?tuple_set(_), ?tuple(?any, ?any, ?any)) -> ?none;
+t_subtract(?tuple(?any, ?any, ?any) = T1, ?tuple_set(_)) -> T1;
+t_subtract(?tuple(Elements1, Arity1, _Tag1) = T1,
+ ?tuple(Elements2, Arity2, _Tag2)) ->
+ if Arity1 =/= Arity2 -> T1;
+ Arity1 =:= Arity2 ->
+ NewElements = t_subtract_lists(Elements1, Elements2),
+ case [E || E <- NewElements, E =/= ?none] of
+ [] -> ?none;
+ [_] -> t_tuple(replace_nontrivial_element(Elements1, NewElements));
+ _ -> T1
+ end
+ end;
+t_subtract(?tuple_set(List1) = T1, ?tuple(_, Arity, _) = T2) ->
+ case orddict:find(Arity, List1) of
+ error -> T1;
+ {ok, List2} ->
+ TuplesLeft0 = [Tuple || {_Arity, Tuple} <- orddict:erase(Arity, List1)],
+ TuplesLeft1 = lists:append(TuplesLeft0),
+ t_sup([t_subtract(L, T2) || L <- List2] ++ TuplesLeft1)
+ end;
+t_subtract(?tuple(_, Arity, _) = T1, ?tuple_set(List1)) ->
+ case orddict:find(Arity, List1) of
+ error -> T1;
+ {ok, List2} -> t_inf([t_subtract(T1, L) || L <- List2])
+ end;
+t_subtract(?tuple_set(_) = T1, ?tuple_set(_) = T2) ->
+ t_sup([t_subtract(T, T2) || T <- t_tuple_subtypes(T1)]);
+t_subtract(?product(Elements1) = T1, ?product(Elements2)) ->
+ Arity1 = length(Elements1),
+ Arity2 = length(Elements2),
+ if Arity1 =/= Arity2 -> T1;
+ Arity1 =:= Arity2 ->
+ NewElements = t_subtract_lists(Elements1, Elements2),
+ case [E || E <- NewElements, E =/= ?none] of
+ [] -> ?none;
+ [_] -> t_product(replace_nontrivial_element(Elements1, NewElements));
+ _ -> T1
+ end
+ end;
+t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) ->
+ case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of
+ false -> A;
+ true ->
+ %% We fold over the maps to produce a list of constraints, where
+ %% constraints are additional key-value pairs to put in Pairs. Only one
+ %% constraint need to be applied to produce a type that excludes the
+ %% right-hand-side type, so if more than one constraint is produced, we
+ %% just return the left-hand-side argument.
+ %%
+ %% Each case of the fold may either conclude that
+ %% * The arguments constrain A at least as much as B, i.e. that A so far
+ %% is a subtype of B. In that case they return false
+ %% * That for the particular arguments, A being a subtype of B does not
+ %% hold, but the infinimum of A and B is nonempty, and by narrowing a
+ %% pair in A, we can create a type that excludes some elements in the
+ %% infinumum. In that case, they will return that pair.
+ %% * That for the particular arguments, A being a subtype of B does not
+ %% hold, and either the infinumum of A and B is empty, or it is not
+ %% possible with the current representation to create a type that
+ %% excludes elements from B without also excluding elements that are
+ %% only in A. In that case, it will return the pair from A unchanged.
+ case
+ map_pairwise_merge(
+ %% If V1 is a subtype of V2, the case that K does not exist in A
+ %% remain.
+ fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)};
+ (K, _, V1, _, V2) ->
+ %% If we subtract an optional key, that leaves a mandatory key
+ case t_subtract(V1, V2) of
+ ?none -> false;
+ Partial -> {K, ?mand, Partial}
+ end
+ end, A, B)
+ of
+ %% We produce a list of keys that are constrained. As only one of
+ %% these should apply at a time, we can't represent the difference if
+ %% more than one constraint is produced. If we applied all of them,
+ %% that would make an underapproximation, which we must not do.
+ [] -> ?none; %% A is a subtype of B
+ [E] -> t_map(mapdict_store(E, APairs), ADefK, ADefV);
+ _ -> A
+ end
+ end;
+t_subtract(?product(P1), _) ->
+ ?product(P1);
+t_subtract(T, ?product(_)) ->
+ T;
+t_subtract(?union(U1), ?union(U2)) ->
+ subtract_union(U1, U2);
+t_subtract(T1, T2) ->
+ ?union(U1) = force_union(T1),
+ ?union(U2) = force_union(T2),
+ subtract_union(U1, U2).
+
+-spec opaque_subtract(erl_type(), erl_type()) -> erl_type().
+
+opaque_subtract(?opaque(Set1), T2) ->
+ List = [T1#opaque{struct = Sub} ||
+ #opaque{struct = S1}=T1 <- set_to_list(Set1),
+ not t_is_none(Sub = t_subtract(S1, T2))],
+ case List of
+ [] -> ?none;
+ _ -> ?opaque(ordsets:from_list(List))
+ end.
+
+-spec t_subtract_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_subtract_lists(L1, L2) ->
+ t_subtract_lists(L1, L2, []).
+
+-spec t_subtract_lists([erl_type()], [erl_type()], [erl_type()]) -> [erl_type()].
+
+t_subtract_lists([T1|Left1], [T2|Left2], Acc) ->
+ t_subtract_lists(Left1, Left2, [t_subtract(T1, T2)|Acc]);
+t_subtract_lists([], [], Acc) ->
+ lists:reverse(Acc).
+
+-spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type().
+
+subtract_union(U1, U2) ->
+ [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1,
+ [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2,
+ List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1],
+ List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2],
+ Sub1 = subtract_union(List1, List2, 0, []),
+ O = if O1 =:= ?none -> O1;
+ true -> t_subtract(O1, ?union(U2))
+ end,
+ Sub2 = if O2 =:= ?none -> Sub1;
+ true -> t_subtract(Sub1, t_opaque_structure(O2))
+ end,
+ t_sup(O, Sub2).
+
+-spec subtract_union([erl_type()], [erl_type()], non_neg_integer(), [erl_type()]) -> erl_type().
+
+subtract_union([T1|Left1], [T2|Left2], N, Acc) ->
+ case t_subtract(T1, T2) of
+ ?none -> subtract_union(Left1, Left2, N, [?none|Acc]);
+ T -> subtract_union(Left1, Left2, N+1, [T|Acc])
+ end;
+subtract_union([], [], 0, _Acc) ->
+ ?none;
+subtract_union([], [], 1, Acc) ->
+ [T] = [X || X <- Acc, X =/= ?none],
+ T;
+subtract_union([], [], N, Acc) when is_integer(N), N > 1 ->
+ ?union(lists:reverse(Acc)).
+
+replace_nontrivial_element(El1, El2) ->
+ replace_nontrivial_element(El1, El2, []).
+
+replace_nontrivial_element([T1|Left1], [?none|Left2], Acc) ->
+ replace_nontrivial_element(Left1, Left2, [T1|Acc]);
+replace_nontrivial_element([_|Left1], [T2|_], Acc) ->
+ lists:reverse(Acc) ++ [T2|Left1].
+
+subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B1)) ->
+ ?none;
+subtract_bin(?bitstr(U1, B1), ?none) ->
+ t_bitstr(U1, B1);
+subtract_bin(?bitstr(U1, B1), ?bitstr(0, B1)) ->
+ t_bitstr(U1, B1+U1);
+subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B2)) ->
+ if (B1+U1) =/= B2 -> t_bitstr(0, B1);
+ true -> t_bitstr(U1, B1)
+ end;
+subtract_bin(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ if (2 * U1) =:= U2 ->
+ if B1 =:= B2 ->
+ t_bitstr(U2, B1+U1);
+ (B1 + U1) =:= B2 ->
+ t_bitstr(U2, B1);
+ true ->
+ t_bitstr(U1, B1)
+ end;
+ true ->
+ t_bitstr(U1, B1)
+ end.
+
+%%-----------------------------------------------------------------------------
+%% Relations
+%%
+
+-spec t_is_equal(erl_type(), erl_type()) -> boolean().
+
+t_is_equal(T, T) -> true;
+t_is_equal(_, _) -> false.
+
+-spec t_is_subtype(erl_type(), erl_type()) -> boolean().
+
+t_is_subtype(T1, T2) ->
+ Inf = t_inf(T1, T2),
+ subtype_is_equal(T1, Inf).
+
+%% The subtype relation has to behave correctly irrespective of opaque
+%% types.
+subtype_is_equal(T, T) -> true;
+subtype_is_equal(T1, T2) ->
+ t_is_equal(case t_contains_opaque(T1) of
+ true -> t_unopaque(T1);
+ false -> T1
+ end,
+ case t_contains_opaque(T2) of
+ true -> t_unopaque(T2);
+ false -> T2
+ end).
+
+-spec t_is_instance(erl_type(), erl_type()) -> boolean().
+
+%% XXX. To be removed.
+t_is_instance(ConcreteType, Type) ->
+ t_is_subtype(ConcreteType, t_unopaque(Type)).
+
+-spec t_do_overlap(erl_type(), erl_type()) -> boolean().
+
+t_do_overlap(TypeA, TypeB) ->
+ not (t_is_none_or_unit(t_inf(TypeA, TypeB))).
+
+-spec t_unopaque(erl_type()) -> erl_type().
+
+t_unopaque(T) ->
+ t_unopaque(T, 'universe').
+
+-spec t_unopaque(erl_type(), opaques()) -> erl_type().
+
+t_unopaque(?opaque(_) = T, Opaques) ->
+ case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of
+ true -> t_unopaque(t_opaque_structure(T), Opaques);
+ false -> T
+ end;
+t_unopaque(?list(ElemT, Termination, Sz), Opaques) ->
+ ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz);
+t_unopaque(?tuple(?any, _, _) = T, _) -> T;
+t_unopaque(?tuple(ArgTs, Sz, Tag), Opaques) when is_list(ArgTs) ->
+ NewArgTs = [t_unopaque(A, Opaques) || A <- ArgTs],
+ ?tuple(NewArgTs, Sz, Tag);
+t_unopaque(?tuple_set(Set), Opaques) ->
+ NewSet = [{Sz, [t_unopaque(T, Opaques) || T <- Tuples]}
+ || {Sz, Tuples} <- Set],
+ ?tuple_set(NewSet);
+t_unopaque(?product(Types), Opaques) ->
+ ?product([t_unopaque(T, Opaques) || T <- Types]);
+t_unopaque(?function(Domain, Range), Opaques) ->
+ ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques));
+t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) ->
+ UL = t_unopaque(L, Opaques),
+ UT = t_unopaque(T, Opaques),
+ UF = t_unopaque(F, Opaques),
+ UM = t_unopaque(M, Opaques),
+ UMap = t_unopaque(Map, Opaques),
+ {OF,UO} = case t_unopaque(O, Opaques) of
+ ?opaque(_) = O1 -> {O1, []};
+ Type -> {?none, [Type]}
+ end,
+ t_sup([?union([A,B,UF,I,UL,N,UT,UM,OF,UMap])|UO]);
+t_unopaque(?map(Pairs,DefK,DefV), Opaques) ->
+ t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs],
+ t_unopaque(DefK, Opaques),
+ t_unopaque(DefV, Opaques));
+t_unopaque(T, _) ->
+ T.
+
+%%-----------------------------------------------------------------------------
+%% K-depth abstraction.
+%%
+%% t_limit/2 is the exported function, which checks the type of the
+%% second argument and calls the module local t_limit_k/2 function.
+%%
+
+-spec t_limit(erl_type(), integer()) -> erl_type().
+
+t_limit(Term, K) when is_integer(K) ->
+ t_limit_k(Term, K).
+
+t_limit_k(_, K) when K =< 0 -> ?any;
+t_limit_k(?tuple(?any, ?any, ?any) = T, _K) -> T;
+t_limit_k(?tuple(Elements, Arity, _), K) ->
+ if K =:= 1 -> t_tuple(Arity);
+ true -> t_tuple([t_limit_k(E, K-1) || E <- Elements])
+ end;
+t_limit_k(?tuple_set(_) = T, K) ->
+ t_sup([t_limit_k(Tuple, K) || Tuple <- t_tuple_subtypes(T)]);
+t_limit_k(?list(Elements, Termination, Size), K) ->
+ NewTermination =
+ if K =:= 1 ->
+ %% We do not want to lose the termination information.
+ t_limit_k(Termination, K);
+ true -> t_limit_k(Termination, K - 1)
+ end,
+ NewElements = t_limit_k(Elements, K - 1),
+ TmpList = t_cons(NewElements, NewTermination),
+ case Size of
+ ?nonempty_qual -> TmpList;
+ ?unknown_qual ->
+ ?list(NewElements1, NewTermination1, _) = TmpList,
+ ?list(NewElements1, NewTermination1, ?unknown_qual)
+ end;
+t_limit_k(?function(Domain, Range), K) ->
+ %% The domain is either a product or any() so we do not decrease the K.
+ ?function(t_limit_k(Domain, K), t_limit_k(Range, K-1));
+t_limit_k(?product(Elements), K) ->
+ ?product([t_limit_k(X, K - 1) || X <- Elements]);
+t_limit_k(?union(Elements), K) ->
+ ?union([t_limit_k(X, K) || X <- Elements]);
+t_limit_k(?opaque(Es), K) ->
+ List = [begin
+ NewS = t_limit_k(S, K),
+ Opaque#opaque{struct = NewS}
+ end || #opaque{struct = S} = Opaque <- set_to_list(Es)],
+ ?opaque(ordsets:from_list(List));
+t_limit_k(?map(Pairs0, DefK0, DefV0), K) ->
+ Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) ->
+ LV = t_limit_k(EV, K - 1),
+ case t_limit_k(EK, K - 1) of
+ EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1};
+ LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)}
+ end
+ end,
+ {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0),
+ t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1));
+t_limit_k(T, _K) -> T.
+
+%%============================================================================
+%%
+%% Abstract records. Used for comparing contracts.
+%%
+%%============================================================================
+
+-spec t_abstract_records(erl_type(), type_table()) -> erl_type().
+
+t_abstract_records(?list(Contents, Termination, Size), RecDict) ->
+ case t_abstract_records(Contents, RecDict) of
+ ?none -> ?none;
+ NewContents ->
+ %% Be careful here to make the termination collapse if necessary.
+ case t_abstract_records(Termination, RecDict) of
+ ?nil -> ?list(NewContents, ?nil, Size);
+ ?any -> ?list(NewContents, ?any, Size);
+ Other ->
+ ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other),
+ ?list(NewContents2, NewTermination, Size)
+ end
+ end;
+t_abstract_records(?function(Domain, Range), RecDict) ->
+ ?function(t_abstract_records(Domain, RecDict),
+ t_abstract_records(Range, RecDict));
+t_abstract_records(?product(Types), RecDict) ->
+ ?product([t_abstract_records(T, RecDict) || T <- Types]);
+t_abstract_records(?union(Types), RecDict) ->
+ t_sup([t_abstract_records(T, RecDict) || T <- Types]);
+t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) ->
+ T;
+t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) ->
+ [TagAtom] = atom_vals(Tag),
+ case lookup_record(TagAtom, Arity - 1, RecDict) of
+ error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
+ {ok, Fields} -> t_tuple([Tag|[T || {_Name, _Abstr, T} <- Fields]])
+ end;
+t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) ->
+ t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
+t_abstract_records(?tuple_set(_) = Tuples, RecDict) ->
+ t_sup([t_abstract_records(T, RecDict) || T <- t_tuple_subtypes(Tuples)]);
+t_abstract_records(?opaque(_)=Type, RecDict) ->
+ t_abstract_records(t_opaque_structure(Type), RecDict);
+t_abstract_records(T, _RecDict) ->
+ T.
+
+%%=============================================================================
+%%
+%% Prettyprinter
+%%
+%%=============================================================================
+
+-spec t_to_string(erl_type()) -> string().
+
+t_to_string(T) ->
+ t_to_string(T, maps:new()).
+
+-spec t_to_string(erl_type(), type_table()) -> string().
+
+t_to_string(?any, _RecDict) ->
+ "any()";
+t_to_string(?none, _RecDict) ->
+ "none()";
+t_to_string(?unit, _RecDict) ->
+ "no_return()";
+t_to_string(?atom(?any), _RecDict) ->
+ "atom()";
+t_to_string(?atom(Set), _RecDict) ->
+ case set_size(Set) of
+ 2 ->
+ case set_is_element(true, Set) andalso set_is_element(false, Set) of
+ true -> "boolean()";
+ false -> set_to_string(Set)
+ end;
+ _ ->
+ set_to_string(Set)
+ end;
+t_to_string(?bitstr(0, 0), _RecDict) ->
+ "<<>>";
+t_to_string(?bitstr(8, 0), _RecDict) ->
+ "binary()";
+t_to_string(?bitstr(1, 0), _RecDict) ->
+ "bitstring()";
+t_to_string(?bitstr(0, B), _RecDict) ->
+ flat_format("<<_:~w>>", [B]);
+t_to_string(?bitstr(U, 0), _RecDict) ->
+ flat_format("<<_:_*~w>>", [U]);
+t_to_string(?bitstr(U, B), _RecDict) ->
+ flat_format("<<_:~w,_:_*~w>>", [B, U]);
+t_to_string(?function(?any, ?any), _RecDict) ->
+ "fun()";
+t_to_string(?function(?any, Range), RecDict) ->
+ "fun((...) -> " ++ t_to_string(Range, RecDict) ++ ")";
+t_to_string(?function(?product(ArgList), Range), RecDict) ->
+ "fun((" ++ comma_sequence(ArgList, RecDict) ++ ") -> "
+ ++ t_to_string(Range, RecDict) ++ ")";
+t_to_string(?identifier(Set), _RecDict) ->
+ case Set of
+ ?any -> "identifier()";
+ _ ->
+ flat_join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ")
+ end;
+t_to_string(?opaque(Set), RecDict) ->
+ flat_join([opaque_type(Mod, Name, Args, S, RecDict) ||
+ #opaque{mod = Mod, name = Name, struct = S, args = Args}
+ <- set_to_list(Set)],
+ " | ");
+t_to_string(?matchstate(Pres, Slots), RecDict) ->
+ flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict),
+ t_to_string(Slots,RecDict)]);
+t_to_string(?nil, _RecDict) ->
+ "[]";
+t_to_string(?nonempty_list(Contents, Termination), RecDict) ->
+ ContentString = t_to_string(Contents, RecDict),
+ case Termination of
+ ?nil ->
+ case Contents of
+ ?char -> "nonempty_string()";
+ _ -> "["++ContentString++",...]"
+ end;
+ ?any ->
+ %% Just a safety check.
+ case Contents =:= ?any of
+ true -> ok;
+ false ->
+ %% XXX. See comment below.
+ %% erlang:error({illegal_list, ?nonempty_list(Contents, Termination)})
+ ok
+ end,
+ "nonempty_maybe_improper_list()";
+ _ ->
+ case t_is_subtype(t_nil(), Termination) of
+ true ->
+ "nonempty_maybe_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")";
+ false ->
+ "nonempty_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")"
+ end
+ end;
+t_to_string(?list(Contents, Termination, ?unknown_qual), RecDict) ->
+ ContentString = t_to_string(Contents, RecDict),
+ case Termination of
+ ?nil ->
+ case Contents of
+ ?char -> "string()";
+ _ -> "["++ContentString++"]"
+ end;
+ ?any ->
+ %% Just a safety check.
+ %% XXX. Types such as "maybe_improper_list(integer(), any())"
+ %% are OK, but cannot be printed!?
+ case Contents =:= ?any of
+ true -> ok;
+ false ->
+ ok
+ %% L = ?list(Contents, Termination, ?unknown_qual),
+ %% erlang:error({illegal_list, L})
+ end,
+ "maybe_improper_list()";
+ _ ->
+ case t_is_subtype(t_nil(), Termination) of
+ true ->
+ "maybe_improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")";
+ false ->
+ "improper_list("++ContentString++","
+ ++t_to_string(Termination, RecDict)++")"
+ end
+ end;
+t_to_string(?int_set(Set), _RecDict) ->
+ set_to_string(Set);
+t_to_string(?byte, _RecDict) -> "byte()";
+t_to_string(?char, _RecDict) -> "char()";
+t_to_string(?integer_pos, _RecDict) -> "pos_integer()";
+t_to_string(?integer_non_neg, _RecDict) -> "non_neg_integer()";
+t_to_string(?integer_neg, _RecDict) -> "neg_integer()";
+t_to_string(?int_range(From, To), _RecDict) ->
+ flat_format("~w..~w", [From, To]);
+t_to_string(?integer(?any), _RecDict) -> "integer()";
+t_to_string(?float, _RecDict) -> "float()";
+t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()";
+t_to_string(?product(List), RecDict) ->
+ "<" ++ comma_sequence(List, RecDict) ++ ">";
+t_to_string(?map([],?any,?any), _RecDict) -> "map()";
+t_to_string(?map(Pairs0,DefK,DefV), RecDict) ->
+ {Pairs, ExtraEl} =
+ case {DefK, DefV} of
+ {?none, ?none} -> {Pairs0, []};
+ _ -> {Pairs0 ++ [{DefK,?opt,DefV}], []}
+ end,
+ Tos = fun(T) -> case T of
+ ?any -> "_";
+ _ -> t_to_string(T, RecDict)
+ end end,
+ StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs],
+ StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs],
+ "#{" ++ flat_join([K ++ ":=" ++ V||{K,V}<-StrMand]
+ ++ [K ++ "=>" ++ V||{K,V}<-StrOpt]
+ ++ ExtraEl, ", ") ++ "}";
+t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
+t_to_string(?tuple(Elements, _Arity, ?any), RecDict) ->
+ "{" ++ comma_sequence(Elements, RecDict) ++ "}";
+t_to_string(?tuple(Elements, Arity, Tag), RecDict) ->
+ [TagAtom] = atom_vals(Tag),
+ case lookup_record(TagAtom, Arity-1, RecDict) of
+ error -> "{" ++ comma_sequence(Elements, RecDict) ++ "}";
+ {ok, FieldNames} ->
+ record_to_string(TagAtom, Elements, FieldNames, RecDict)
+ end;
+t_to_string(?tuple_set(_) = T, RecDict) ->
+ union_sequence(t_tuple_subtypes(T), RecDict);
+t_to_string(?union(Types), RecDict) ->
+ union_sequence([T || T <- Types, T =/= ?none], RecDict);
+t_to_string(?var(Id), _RecDict) when is_atom(Id) ->
+ flat_format("~s", [atom_to_list(Id)]);
+t_to_string(?var(Id), _RecDict) when is_integer(Id) ->
+ flat_format("var(~w)", [Id]).
+
+
+record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
+ FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
+ "#" ++ atom_to_string(Tag) ++ "{" ++ flat_join(FieldStrings, ",") ++ "}".
+
+record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs],
+ RecDict, Acc) ->
+ NewAcc =
+ case
+ t_is_equal(F, t_any()) orelse
+ (t_is_any_atom('undefined', F) andalso
+ not t_is_none(t_inf(F, DefType)))
+ of
+ true -> Acc;
+ false ->
+ StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict),
+ [StrFV|Acc]
+ end,
+ record_fields_to_string(Fs, FDefs, RecDict, NewAcc);
+record_fields_to_string([], [], _RecDict, Acc) ->
+ lists:reverse(Acc).
+
+-spec record_field_diffs_to_string(erl_type(), type_table()) -> string().
+
+record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) ->
+ [TagAtom] = atom_vals(Tag),
+ {ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict),
+ %% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]),
+ FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []),
+ flat_join(FieldDiffs, " and ").
+
+field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) ->
+ %% Don't care about opacity for now.
+ NewAcc =
+ case not t_is_none(t_inf(F, DefType)) of
+ true -> Acc;
+ false ->
+ Str = atom_to_string(FName) ++ "::" ++ t_to_string(DefType, RecDict),
+ [Str|Acc]
+ end,
+ field_diffs(Fs, FDefs, RecDict, NewAcc);
+field_diffs([], [], _, Acc) ->
+ lists:reverse(Acc).
+
+comma_sequence(Types, RecDict) ->
+ List = [case T =:= ?any of
+ true -> "_";
+ false -> t_to_string(T, RecDict)
+ end || T <- Types],
+ flat_join(List, ",").
+
+union_sequence(Types, RecDict) ->
+ List = [t_to_string(T, RecDict) || T <- Types],
+ flat_join(List, " | ").
+
+-ifdef(DEBUG).
+opaque_type(Mod, Name, _Args, S, RecDict) ->
+ ArgsString = comma_sequence(_Args, RecDict),
+ String = t_to_string(S, RecDict),
+ opaque_name(Mod, Name, ArgsString) ++ "[" ++ String ++ "]".
+-else.
+opaque_type(Mod, Name, Args, _S, RecDict) ->
+ ArgsString = comma_sequence(Args, RecDict),
+ opaque_name(Mod, Name, ArgsString).
+-endif.
+
+opaque_name(Mod, Name, Extra) ->
+ S = mod_name(Mod, Name),
+ flat_format("~ts(~ts)", [S, Extra]).
+
+mod_name(Mod, Name) ->
+ flat_format("~w:~tw", [Mod, Name]).
+
+%%=============================================================================
+%%
+%% Build a type from parse forms.
+%%
+%%=============================================================================
+
+-type type_names() :: [type_key() | record_key()].
+
+-type mta() :: {module(), atom(), arity()}.
+-type mra() :: {module(), atom(), arity()}.
+-type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}.
+-type cache_key() :: {module(), atom(), expand_depth(),
+ [erl_type()], type_names()}.
+-type mod_type_table() :: ets:tid().
+-type mod_records() :: dict:dict(module(), type_table()).
+-record(cache,
+ {
+ types = maps:new() :: #{cache_key() => {erl_type(), expand_limit()}},
+ mod_recs = {mrecs, dict:new()} :: {'mrecs', mod_records()}
+ }).
+
+-opaque cache() :: #cache{}.
+
+-spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_type_table(),
+ var_table(), cache()) -> {erl_type(), cache()}.
+
+t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) ->
+ t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache).
+
+%% Replace external types with with none().
+-spec t_from_form_without_remote(parse_form(), site(), type_table()) ->
+ erl_type().
+
+t_from_form_without_remote(Form, Site, TypeTable) ->
+ Module = site_module(Site),
+ ModRecs = dict:from_list([{Module, TypeTable}]),
+ ExpTypes = replace_by_none,
+ VarTab = var_table__new(),
+ Cache0 = cache__new(),
+ Cache = Cache0#cache{mod_recs = {mrecs, ModRecs}},
+ {Type, _} = t_from_form1(Form, ExpTypes, Site, undefined, VarTab, Cache),
+ Type.
+
+-type expand_limit() :: integer().
+
+-type expand_depth() :: integer().
+
+-record(from_form, {site :: site() | {'check', mta()},
+ xtypes :: sets:set(mfa()) | 'replace_by_none',
+ mrecs :: 'undefined' | mod_type_table(),
+ vtab :: var_table(),
+ tnames :: type_names()}).
+
+-spec t_from_form_check_remote(parse_form(), sets:set(mfa()), mta(),
+ mod_type_table()) -> 'ok'.
+t_from_form_check_remote(Form, ExpTypes, MTA, RecDict) ->
+ State = #from_form{site = {check, MTA},
+ xtypes = ExpTypes,
+ mrecs = RecDict,
+ vtab = var_table__new(),
+ tnames = []},
+ D = (1 bsl 25), % unlimited
+ L = (1 bsl 25),
+ Cache0 = cache__new(),
+ _ = t_from_form2(Form, State, D, L, Cache0),
+ ok.
+
+%% REC_TYPE_LIMIT is used for limiting the depth of recursive types.
+%% EXPAND_LIMIT is used for limiting the size of types by
+%% limiting the number of elements of lists within one type form.
+%% EXPAND_DEPTH is used in conjunction with EXPAND_LIMIT to make the
+%% types balanced (unions will otherwise collapse to any()) by limiting
+%% the depth the same way as t_limit/2 does.
+
+-spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none',
+ site(), 'undefined' | mod_type_table(), var_table(),
+ cache()) -> {erl_type(), cache()}.
+
+t_from_form1(Form, ET, Site, MR, V, C) ->
+ TypeNames = initial_typenames(Site),
+ D = ?EXPAND_DEPTH,
+ L = ?EXPAND_LIMIT,
+ State = #from_form{site = Site,
+ xtypes = ET,
+ mrecs = MR,
+ vtab = V,
+ tnames = TypeNames},
+ t_from_form2(Form, State, D, L, C).
+
+t_from_form2(Form, State, D, L, C) ->
+ {T0, L0, C0} = from_form(Form, State, D, L, C),
+ if
+ L0 =< 0 ->
+ {T1, _, C1} = from_form(Form, State, 1, L, C0),
+ from_form_loop(Form, State, 2, L, C1, T1);
+ true ->
+ {T0, C0}
+ end.
+
+initial_typenames({type, _MTA}=Site) -> [Site];
+initial_typenames({spec, _MFA}) -> [];
+initial_typenames({record, _MRA}) -> [].
+
+from_form_loop(Form, State, D, Limit, C, T0) ->
+ {T1, L1, C1} = from_form(Form, State, D, Limit, C),
+ Delta = Limit - L1,
+ if
+ L1 =< 0 ->
+ {T0, C1};
+ Delta * 8 > Limit ->
+ %% Save some time by assuming next depth will exceed the limit.
+ {T1, C1};
+ true ->
+ D1 = D + 1,
+ from_form_loop(Form, State, D1, Limit, C1, T1)
+ end.
+
+-spec from_form(parse_form(),
+ #from_form{},
+ expand_depth(),
+ expand_limit(),
+ cache()) -> {erl_type(), expand_limit(), cache()}.
+
+%% If there is something wrong with parse_form()
+%% throw({error, io_lib:chars()} is called;
+%% for unknown remote types
+%% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}
+%% is called, unless 'replace_by_none' is given.
+%%
+%% It is assumed that site_module(S) can be found in MR.
+
+from_form(_, _S, D, L, C) when D =< 0 ; L =< 0 ->
+ {t_any(), L, C};
+from_form({var, _L, '_'}, _S, _D, L, C) ->
+ {t_any(), L, C};
+from_form({var, _L, Name}, S, _D, L, C) ->
+ V = S#from_form.vtab,
+ case maps:find(Name, V) of
+ error -> {t_var(Name), L, C};
+ {ok, Val} -> {Val, L, C}
+ end;
+from_form({ann_type, _L, [_Var, Type]}, S, D, L, C) ->
+ from_form(Type, S, D, L, C);
+from_form({paren_type, _L, [Type]}, S, D, L, C) ->
+ from_form(Type, S, D, L, C);
+from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
+ S, D, L, C) ->
+ remote_from_form(Module, Type, Args, S, D, L, C);
+from_form({atom, _L, Atom}, _S, _D, L, C) ->
+ {t_atom(Atom), L, C};
+from_form({integer, _L, Int}, _S, _D, L, C) ->
+ {t_integer(Int), L, C};
+from_form({char, _L, Char}, _S, _D, L, C) ->
+ {t_integer(Char), L, C};
+from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) ->
+ case erl_eval:partial_eval(Op) of
+ {integer, _, Val} ->
+ {t_integer(Val), L, C};
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
+ end;
+from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _S, _D, L, C) ->
+ case erl_eval:partial_eval(Op) of
+ {integer, _, Val} ->
+ {t_integer(Val), L, C};
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
+ end;
+from_form({type, _L, any, []}, _S, _D, L, C) ->
+ {t_any(), L, C};
+from_form({type, _L, arity, []}, _S, _D, L, C) ->
+ {t_arity(), L, C};
+from_form({type, _L, atom, []}, _S, _D, L, C) ->
+ {t_atom(), L, C};
+from_form({type, _L, binary, []}, _S, _D, L, C) ->
+ {t_binary(), L, C};
+from_form({type, _L, binary, [Base, Unit]} = Type, _S, _D, L, C) ->
+ case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
+ {{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 ->
+ {t_bitstr(U, B), L, C};
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
+ end;
+from_form({type, _L, bitstring, []}, _S, _D, L, C) ->
+ {t_bitstr(), L, C};
+from_form({type, _L, bool, []}, _S, _D, L, C) ->
+ {t_boolean(), L, C}; % XXX: Temporarily
+from_form({type, _L, boolean, []}, _S, _D, L, C) ->
+ {t_boolean(), L, C};
+from_form({type, _L, byte, []}, _S, _D, L, C) ->
+ {t_byte(), L, C};
+from_form({type, _L, char, []}, _S, _D, L, C) ->
+ {t_char(), L, C};
+from_form({type, _L, float, []}, _S, _D, L, C) ->
+ {t_float(), L, C};
+from_form({type, _L, function, []}, _S, _D, L, C) ->
+ {t_fun(), L, C};
+from_form({type, _L, 'fun', []}, _S, _D, L, C) ->
+ {t_fun(), L, C};
+from_form({type, _L, 'fun', [{type, _, any}, Range]}, S, D, L, C) ->
+ {T, L1, C1} = from_form(Range, S, D - 1, L - 1, C),
+ {t_fun(T), L1, C1};
+from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
+ S, D, L, C) ->
+ {Dom1, L1, C1} = list_from_form(Domain, S, D, L, C),
+ {Ran1, L2, C2} = from_form(Range, S, D, L1, C1),
+ {t_fun(Dom1, Ran1), L2, C2};
+from_form({type, _L, identifier, []}, _S, _D, L, C) ->
+ {t_identifier(), L, C};
+from_form({type, _L, integer, []}, _S, _D, L, C) ->
+ {t_integer(), L, C};
+from_form({type, _L, iodata, []}, _S, _D, L, C) ->
+ {t_iodata(), L, C};
+from_form({type, _L, iolist, []}, _S, _D, L, C) ->
+ {t_iolist(), L, C};
+from_form({type, _L, list, []}, _S, _D, L, C) ->
+ {t_list(), L, C};
+from_form({type, _L, list, [Type]}, S, D, L, C) ->
+ {T, L1, C1} = from_form(Type, S, D - 1, L - 1, C),
+ {t_list(T), L1, C1};
+from_form({type, _L, map, any}, S, D, L, C) ->
+ builtin_type(map, t_map(), S, D, L, C);
+from_form({type, _L, map, List}, S, D0, L, C) ->
+ {Pairs1, L5, C5} =
+ fun PairsFromForm(_, L1, C1) when L1 =< 0 -> {[{?any,?opt,?any}], L1, C1};
+ PairsFromForm([], L1, C1) -> {[], L1, C1};
+ PairsFromForm([{type, _, Oper, [KF, VF]}|T], L1, C1) ->
+ D = D0 - 1,
+ {Key, L2, C2} = from_form(KF, S, D, L1, C1),
+ {Val, L3, C3} = from_form(VF, S, D, L2, C2),
+ {Pairs0, L4, C4} = PairsFromForm(T, L3 - 1, C3),
+ case Oper of
+ map_field_assoc -> {[{Key,?opt, Val}|Pairs0], L4, C4};
+ map_field_exact -> {[{Key,?mand,Val}|Pairs0], L4, C4}
+ end
+ end(List, L, C),
+ try
+ Pairs2 = singleton_elements(Pairs1),
+ {Pairs, DefK, DefV} = map_from_form(Pairs2, [], [], [], ?none, ?none),
+ {t_map(Pairs, DefK, DefV), L5, C5}
+ catch none -> {t_none(), L5, C5}
+ end;
+from_form({type, _L, mfa, []}, _S, _D, L, C) ->
+ {t_mfa(), L, C};
+from_form({type, _L, module, []}, _S, _D, L, C) ->
+ {t_module(), L, C};
+from_form({type, _L, nil, []}, _S, _D, L, C) ->
+ {t_nil(), L, C};
+from_form({type, _L, neg_integer, []}, _S, _D, L, C) ->
+ {t_neg_integer(), L, C};
+from_form({type, _L, non_neg_integer, []}, _S, _D, L, C) ->
+ {t_non_neg_integer(), L, C};
+from_form({type, _L, no_return, []}, _S, _D, L, C) ->
+ {t_unit(), L, C};
+from_form({type, _L, node, []}, _S, _D, L, C) ->
+ {t_node(), L, C};
+from_form({type, _L, none, []}, _S, _D, L, C) ->
+ {t_none(), L, C};
+from_form({type, _L, nonempty_list, []}, _S, _D, L, C) ->
+ {t_nonempty_list(), L, C};
+from_form({type, _L, nonempty_list, [Type]}, S, D, L, C) ->
+ {T, L1, C1} = from_form(Type, S, D, L - 1, C),
+ {t_nonempty_list(T), L1, C1};
+from_form({type, _L, nonempty_improper_list, [Cont, Term]}, S, D, L, C) ->
+ {T1, L1, C1} = from_form(Cont, S, D, L - 1, C),
+ {T2, L2, C2} = from_form(Term, S, D, L1, C1),
+ {t_cons(T1, T2), L2, C2};
+from_form({type, _L, nonempty_maybe_improper_list, []}, _S, _D, L, C) ->
+ {t_cons(?any, ?any), L, C};
+from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]},
+ S, D, L, C) ->
+ {T1, L1, C1} = from_form(Cont, S, D, L - 1, C),
+ {T2, L2, C2} = from_form(Term, S, D, L1, C1),
+ {t_cons(T1, T2), L2, C2};
+from_form({type, _L, nonempty_string, []}, _S, _D, L, C) ->
+ {t_nonempty_string(), L, C};
+from_form({type, _L, number, []}, _S, _D, L, C) ->
+ {t_number(), L, C};
+from_form({type, _L, pid, []}, _S, _D, L, C) ->
+ {t_pid(), L, C};
+from_form({type, _L, port, []}, _S, _D, L, C) ->
+ {t_port(), L, C};
+from_form({type, _L, pos_integer, []}, _S, _D, L, C) ->
+ {t_pos_integer(), L, C};
+from_form({type, _L, maybe_improper_list, []}, _S, _D, L, C) ->
+ {t_maybe_improper_list(), L, C};
+from_form({type, _L, maybe_improper_list, [Content, Termination]},
+ S, D, L, C) ->
+ {T1, L1, C1} = from_form(Content, S, D, L - 1, C),
+ {T2, L2, C2} = from_form(Termination, S, D, L1, C1),
+ {t_maybe_improper_list(T1, T2), L2, C2};
+from_form({type, _L, product, Elements}, S, D, L, C) ->
+ {Lst, L1, C1} = list_from_form(Elements, S, D - 1, L, C),
+ {t_product(Lst), L1, C1};
+from_form({type, _L, range, [From, To]} = Type, _S, _D, L, C) ->
+ case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
+ {{integer, _, FromVal}, {integer, _, ToVal}} ->
+ {t_from_range(FromVal, ToVal), L, C};
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
+ end;
+from_form({type, _L, record, [Name|Fields]}, S, D, L, C) ->
+ record_from_form(Name, Fields, S, D, L, C);
+from_form({type, _L, reference, []}, _S, _D, L, C) ->
+ {t_reference(), L, C};
+from_form({type, _L, string, []}, _S, _D, L, C) ->
+ {t_string(), L, C};
+from_form({type, _L, term, []}, _S, _D, L, C) ->
+ {t_any(), L, C};
+from_form({type, _L, timeout, []}, _S, _D, L, C) ->
+ {t_timeout(), L, C};
+from_form({type, _L, tuple, any}, _S, _D, L, C) ->
+ {t_tuple(), L, C};
+from_form({type, _L, tuple, Args}, S, D, L, C) ->
+ {Lst, L1, C1} = list_from_form(Args, S, D - 1, L, C),
+ {t_tuple(Lst), L1, C1};
+from_form({type, _L, union, Args}, S, D, L, C) ->
+ {Lst, L1, C1} = list_from_form(Args, S, D, L, C),
+ {t_sup(Lst), L1, C1};
+from_form({user_type, _L, Name, Args}, S, D, L, C) ->
+ type_from_form(Name, Args, S, D, L, C);
+from_form({type, _L, Name, Args}, S, D, L, C) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
+ type_from_form(Name, Args, S, D, L, C);
+from_form({opaque, _L, Name, {Mod, Args, Rep}}, _S, _D, L, C) ->
+ %% XXX. To be removed.
+ {t_opaque(Mod, Name, Args, Rep), L, C}.
+
+builtin_type(Name, Type, S, D, L, C) ->
+ #from_form{site = Site, mrecs = MR} = S,
+ M = site_module(Site),
+ case lookup_module_types(M, MR, C) of
+ {R, C1} ->
+ case lookup_type(Name, 0, R) of
+ {_, {{_M, _FL, _F, _A}, _T}} ->
+ type_from_form(Name, [], S, D, L, C1);
+ error ->
+ {Type, L, C1}
+ end;
+ error ->
+ {Type, L, C}
+ end.
+
+type_from_form(Name, Args, S, D, L, C) ->
+ #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S,
+ ArgsLen = length(Args),
+ Module = site_module(Site),
+ TypeName = {type, {Module, Name, ArgsLen}},
+ case can_unfold_more(TypeName, TypeNames) of
+ true ->
+ {R, C1} = lookup_module_types(Module, MR, C),
+ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site,
+ S, D, L, C1);
+ false ->
+ {t_any(), L, C}
+ end.
+
+type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site,
+ S, D, L, C) ->
+ case lookup_type(Name, ArgsLen, R) of
+ {_, {_, _}} when element(1, Site) =:= check ->
+ {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C),
+ {t_any(), L1, C1};
+ {Tag, {{Module, _FileName, Form, ArgNames}, Type}} ->
+ NewTypeNames = [TypeName|TypeNames],
+ S1 = S#from_form{tnames = NewTypeNames},
+ {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C),
+ CKey = cache_key(Module, Name, ArgTypes, TypeNames, D),
+ case cache_find(CKey, C) of
+ {CachedType, DeltaL} ->
+ {CachedType, L1 - DeltaL, C};
+ error ->
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpV = maps:from_list(List),
+ S2 = S1#from_form{site = TypeName, vtab = TmpV},
+ Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end,
+ {NewType, L3, C3} =
+ case Tag of
+ type ->
+ recur_limit(Fun, D, L1, TypeName, TypeNames);
+ opaque ->
+ {Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames),
+ Rep1 = choose_opaque_type(Rep, Type),
+ Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of
+ true -> Rep;
+ false ->
+ ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
+ t_opaque(Module, Name, ArgTypes2, Rep1)
+ end,
+ {Rep2, L2, C2}
+ end,
+ C4 = cache_put(CKey, NewType, L1 - L3, C3),
+ {NewType, L3, C4}
+ end;
+ error ->
+ Msg = io_lib:format("Unable to find type ~tw/~w\n",
+ [Name, ArgsLen]),
+ throw({error, Msg})
+ end.
+
+remote_from_form(RemMod, Name, Args, S, D, L, C) ->
+ #from_form{site = Site, xtypes = ET, mrecs = MR, tnames = TypeNames} = S,
+ if
+ ET =:= replace_by_none ->
+ {t_none(), L, C};
+ true ->
+ ArgsLen = length(Args),
+ MFA = {RemMod, Name, ArgsLen},
+ case lookup_module_types(RemMod, MR, C) of
+ error ->
+ self() ! {self(), ext_types, MFA},
+ {t_any(), L, C};
+ {RemDict, C1} ->
+ case sets:is_element(MFA, ET) of
+ true ->
+ RemType = {type, MFA},
+ case can_unfold_more(RemType, TypeNames) of
+ true ->
+ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict,
+ RemType, TypeNames, Site, S, D, L, C1);
+ false ->
+ {t_any(), L, C1}
+ end;
+ false ->
+ self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
+ {t_any(), L, C1}
+ end
+ end
+ end.
+
+remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames,
+ Site, S, D, L, C) ->
+ case lookup_type(Name, ArgsLen, RemDict) of
+ {_, {_, _}} when element(1, Site) =:= check ->
+ {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C),
+ {t_any(), L1, C1};
+ {Tag, {{Mod, _FileLine, Form, ArgNames}, Type}} ->
+ NewTypeNames = [RemType|TypeNames],
+ S1 = S#from_form{tnames = NewTypeNames},
+ {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C),
+ CKey = cache_key(RemMod, Name, ArgTypes, TypeNames, D),
+ case cache_find(CKey, C) of
+ {CachedType, DeltaL} ->
+ {CachedType, L - DeltaL, C};
+ error ->
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpVarTab = maps:from_list(List),
+ S2 = S1#from_form{site = RemType, vtab = TmpVarTab},
+ Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end,
+ {NewType, L3, C3} =
+ case Tag of
+ type ->
+ recur_limit(Fun, D, L1, RemType, TypeNames);
+ opaque ->
+ {NewRep, L2, C2} = recur_limit(Fun, D, L1, RemType, TypeNames),
+ NewRep1 = choose_opaque_type(NewRep, Type),
+ NewRep2 =
+ case cannot_have_opaque(NewRep1, RemType, TypeNames) of
+ true -> NewRep;
+ false ->
+ ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
+ t_opaque(Mod, Name, ArgTypes2, NewRep1)
+ end,
+ {NewRep2, L2, C2}
+ end,
+ C4 = cache_put(CKey, NewType, L1 - L3, C3),
+ {NewType, L3, C4}
+ end;
+ error ->
+ Msg = io_lib:format("Unable to find remote type ~w:~tw()\n",
+ [RemMod, Name]),
+ throw({error, Msg})
+ end.
+
+subst_all_vars_to_any_list(Types) ->
+ [subst_all_vars_to_any(Type) || Type <- Types].
+
+%% Opaque types (both local and remote) are problematic when it comes
+%% to the limits (TypeNames, D, and L). The reason is that if any() is
+%% substituted for a more specialized subtype of an opaque type, the
+%% property stated along with decorate_with_opaque() (the type has to
+%% be a subtype of the declared type) no longer holds.
+%%
+%% The less than perfect remedy: if the opaque type created from a
+%% form is not a subset of the declared type, the declared type is
+%% used instead, effectively bypassing the limits, and potentially
+%% resulting in huge types.
+choose_opaque_type(Type, DeclType) ->
+ case
+ t_is_subtype(subst_all_vars_to_any(Type),
+ subst_all_vars_to_any(DeclType))
+ of
+ true -> Type;
+ false -> DeclType
+ end.
+
+record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) ->
+ #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S,
+ RecordType = {record, Name},
+ case can_unfold_more(RecordType, TypeNames) of
+ true ->
+ M = site_module(Site),
+ {R, C1} = lookup_module_types(M, MR, C),
+ case lookup_record(Name, R) of
+ {ok, _} when element(1, Site) =:= check ->
+ {t_any(), L0, C1};
+ {ok, DeclFields} ->
+ NewTypeNames = [RecordType|TypeNames],
+ Site1 = {record, {M, Name, length(DeclFields)}},
+ S1 = S#from_form{site = Site1, tnames = NewTypeNames},
+ Fun = fun(D, L) ->
+ {GetModRec, L1, C2} =
+ get_mod_record(ModFields, DeclFields, S1, D, L, C1),
+ case GetModRec of
+ {error, FieldName} ->
+ throw({error,
+ io_lib:format("Illegal declaration of #~tw{~tw}\n",
+ [Name, FieldName])});
+ {ok, NewFields} ->
+ S2 = S1#from_form{vtab = var_table__new()},
+ {NewFields1, L2, C3} =
+ fields_from_form(NewFields, S2, D, L1, C2),
+ Rec = t_tuple(
+ [t_atom(Name)|[Type
+ || {_FieldName, Type} <- NewFields1]]),
+ {Rec, L2, C3}
+ end
+ end,
+ recur_limit(Fun, D0, L0, RecordType, TypeNames);
+ error ->
+ throw({error, io_lib:format("Unknown record #~tw{}\n", [Name])})
+ end;
+ false ->
+ {t_any(), L0, C}
+ end.
+
+get_mod_record([], DeclFields, _S, _D, L, C) ->
+ {{ok, DeclFields}, L, C};
+get_mod_record(ModFields, DeclFields, S, D, L, C) ->
+ DeclFieldsDict = lists:keysort(1, DeclFields),
+ {ModFieldsDict, L1, C1} = build_field_dict(ModFields, S, D, L, C),
+ case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of
+ {error, _FieldName} = Error -> {Error, L1, C1};
+ {ok, FinalKeyDict} ->
+ Fields = [lists:keyfind(FieldName, 1, FinalKeyDict)
+ || {FieldName, _, _} <- DeclFields],
+ {{ok, Fields}, L1, C1}
+ end.
+
+build_field_dict(FieldTypes, S, D, L, C) ->
+ build_field_dict(FieldTypes, S, D, L, C, []).
+
+build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left],
+ S, D, L, C, Acc) ->
+ {T, L1, C1} = from_form(Type, S, D, L - 1, C),
+ NewAcc = [{Name, Type, T}|Acc],
+ build_field_dict(Left, S, D, L1, C1, NewAcc);
+build_field_dict([], _S, _D, L, C, Acc) ->
+ {lists:keysort(1, Acc), L, C}.
+
+get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1],
+ [{FieldName, TypeForm, ModType}|Left2],
+ Acc) ->
+ get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]);
+get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1],
+ [{FieldName2, _FormType, _ModType}|_] = List2,
+ Acc) when FieldName1 < FieldName2 ->
+ get_mod_record_types(Left1, List2, [DT|Acc]);
+get_mod_record_types(Left1, [], Acc) ->
+ {ok, lists:keysort(1, Left1++Acc)};
+get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) ->
+ {error, FieldName2}.
+
+%% It is important to create a limited version of the record type
+%% since nested record types can otherwise easily result in huge
+%% terms.
+fields_from_form([], _S, _D, L, C) ->
+ {[], L, C};
+fields_from_form([{Name, Abstr, _Type}|Tail], S, D, L, C) ->
+ {T, L1, C1} = from_form(Abstr, S, D, L, C),
+ {F, L2, C2} = fields_from_form(Tail, S, D, L1, C1),
+ {[{Name, T}|F], L2, C2}.
+
+list_from_form([], _S, _D, L, C) ->
+ {[], L, C};
+list_from_form([H|Tail], S, D, L, C) ->
+ {H1, L1, C1} = from_form(H, S, D, L - 1, C),
+ {T1, L2, C2} = list_from_form(Tail, S, D, L1, C1),
+ {[H1|T1], L2, C2}.
+
+%% Separates singleton types in keys (see is_singleton_type/1).
+singleton_elements([]) ->
+ [];
+singleton_elements([{K,?mand,V}=Pair|Pairs]) ->
+ case is_singleton_type(K) of
+ true ->
+ [Pair|singleton_elements(Pairs)];
+ false ->
+ singleton_elements([{K,?opt,V}|Pairs])
+ end;
+singleton_elements([{Key0,MNess,Val}|Pairs]) ->
+ [{Key,MNess,Val} || Key <- separate_key(Key0)] ++ singleton_elements(Pairs).
+
+%% To be in sync with is_singleton_type/1.
+%% Does not separate tuples and maps as doing that has potential
+%% to be very expensive.
+separate_key(?atom(Atoms)) when Atoms =/= ?any ->
+ [t_atom(A) || A <- Atoms];
+separate_key(?number(_, _) = T) ->
+ t_elements(T);
+separate_key(?union(List)) ->
+ lists:append([separate_key(K) || K <- List, not t_is_none(K)]);
+separate_key(Key) -> [Key].
+
+%% Sorts, combines non-singleton pairs, and applies precendence and
+%% mandatoriness rules.
+map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) ->
+ verify_possible(MKs, ShdwPs),
+ {promote_to_mand(MKs, Pairs), DefK, DefV};
+map_from_form([{SKey,MNess,Val}|SPairs], ShdwPs0, MKs0, Pairs0, DefK0, DefV0) ->
+ Key = lists:foldl(fun({K,_},S)->t_subtract(S,K)end, SKey, ShdwPs0),
+ ShdwPs = case Key of ?none -> ShdwPs0; _ -> [{Key,Val}|ShdwPs0] end,
+ MKs = case MNess of ?mand -> [SKey|MKs0]; ?opt -> MKs0 end,
+ if MNess =:= ?mand, SKey =:= ?none -> throw(none);
+ true -> ok
+ end,
+ {Pairs, DefK, DefV} =
+ case is_singleton_type(Key) of
+ true ->
+ MNess1 = case Val =:= ?none of true -> ?opt; false -> MNess end,
+ {mapdict_insert({Key,MNess1,Val}, Pairs0), DefK0, DefV0};
+ false ->
+ case Key =:= ?none orelse Val =:= ?none of
+ true -> {Pairs0, DefK0, DefV0};
+ false -> {Pairs0, t_sup(DefK0, Key), t_sup(DefV0, Val)}
+ end
+ end,
+ map_from_form(SPairs, ShdwPs, MKs, Pairs, DefK, DefV).
+
+%% Verifies that all mandatory keys are possible, throws 'none' otherwise
+verify_possible(MKs, ShdwPs) ->
+ lists:foreach(fun(M) -> verify_possible_1(M, ShdwPs) end, MKs).
+
+verify_possible_1(M, ShdwPs) ->
+ case lists:any(fun({K,_}) -> t_inf(M, K) =/= ?none end, ShdwPs) of
+ true -> ok;
+ false -> throw(none)
+ end.
+
+-spec promote_to_mand([erl_type()], t_map_dict()) -> t_map_dict().
+
+promote_to_mand(_, []) -> [];
+promote_to_mand(MKs, [E={K,_,V}|T]) ->
+ [case lists:any(fun(M) -> t_is_equal(K,M) end, MKs) of
+ true -> {K, ?mand, V};
+ false -> E
+ end|promote_to_mand(MKs, T)].
+
+-define(RECUR_EXPAND_LIMIT, 10).
+-define(RECUR_EXPAND_DEPTH, 2).
+
+%% If more of the limited resources is spent on the non-recursive
+%% forms, more warnings are found. And the analysis is also a bit
+%% faster.
+%%
+%% Setting REC_TYPE_LIMIT to 1 would work also work well.
+
+recur_limit(Fun, D, L, _, _) when L =< ?RECUR_EXPAND_DEPTH,
+ D =< ?RECUR_EXPAND_LIMIT ->
+ Fun(D, L);
+recur_limit(Fun, D, L, TypeName, TypeNames) ->
+ case is_recursive(TypeName, TypeNames) of
+ true ->
+ {T, L1, C1} = Fun(?RECUR_EXPAND_DEPTH, ?RECUR_EXPAND_LIMIT),
+ {T, L - L1, C1};
+ false ->
+ Fun(D, L)
+ end.
+
+-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(),
+ mod_type_table(), var_table(), cache()) -> cache().
+
+t_check_record_fields(Form, ExpTypes, Site, RecDict, VarTable, Cache) ->
+ State = #from_form{site = Site,
+ xtypes = ExpTypes,
+ mrecs = RecDict,
+ vtab = VarTable,
+ tnames = []},
+ check_record_fields(Form, State, Cache).
+
+-spec check_record_fields(parse_form(), #from_form{}, cache()) -> cache().
+
+%% If there is something wrong with parse_form()
+%% throw({error, io_lib:chars()} is called.
+
+check_record_fields({var, _L, _}, _S, C) -> C;
+check_record_fields({ann_type, _L, [_Var, Type]}, S, C) ->
+ check_record_fields(Type, S, C);
+check_record_fields({paren_type, _L, [Type]}, S, C) ->
+ check_record_fields(Type, S, C);
+check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]},
+ S, C) ->
+ list_check_record_fields(Args, S, C);
+check_record_fields({atom, _L, _}, _S, C) -> C;
+check_record_fields({integer, _L, _}, _S, C) -> C;
+check_record_fields({char, _L, _}, _S, C) -> C;
+check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C;
+check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C;
+check_record_fields({type, _L, tuple, any}, _S, C) -> C;
+check_record_fields({type, _L, map, any}, _S, C) -> C;
+check_record_fields({type, _L, binary, [_Base, _Unit]}, _S, C) -> C;
+check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, S, C) ->
+ check_record_fields(Range, S, C);
+check_record_fields({type, _L, range, [_From, _To]}, _S, C) -> C;
+check_record_fields({type, _L, record, [Name|Fields]}, S, C) ->
+ check_record(Name, Fields, S, C);
+check_record_fields({type, _L, _, Args}, S, C) ->
+ list_check_record_fields(Args, S, C);
+check_record_fields({user_type, _L, _Name, Args}, S, C) ->
+ list_check_record_fields(Args, S, C).
+
+check_record({atom, _, Name}, ModFields, S, C) ->
+ #from_form{site = Site, mrecs = MR} = S,
+ M = site_module(Site),
+ {R, C1} = lookup_module_types(M, MR, C),
+ {ok, DeclFields} = lookup_record(Name, R),
+ case check_fields(Name, ModFields, DeclFields, S, C1) of
+ {error, FieldName} ->
+ throw({error, io_lib:format("Illegal declaration of #~tw{~tw}\n",
+ [Name, FieldName])});
+ C2 -> C2
+ end.
+
+check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left],
+ DeclFields, S, C) ->
+ #from_form{site = Site0, xtypes = ET, mrecs = MR, vtab = V} = S,
+ M = site_module(Site0),
+ Site = {record, {M, RecName, length(DeclFields)}},
+ {Type, C1} = t_from_form(Abstr, ET, Site, MR, V, C),
+ {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields),
+ TypeNoVars = subst_all_vars_to_any(Type),
+ case t_is_subtype(TypeNoVars, DeclType) of
+ false -> {error, Name};
+ true -> check_fields(RecName, Left, DeclFields, S, C1)
+ end;
+check_fields(_RecName, [], _Decl, _S, C) ->
+ C.
+
+list_check_record_fields([], _S, C) ->
+ C;
+list_check_record_fields([H|Tail], S, C) ->
+ C1 = check_record_fields(H, S, C),
+ list_check_record_fields(Tail, S, C1).
+
+site_module({_, {Module, _, _}}) ->
+ Module.
+
+-spec cache__new() -> cache().
+
+cache__new() ->
+ #cache{}.
+
+-spec cache_key(module(), atom(), [erl_type()],
+ type_names(), expand_depth()) -> cache_key().
+
+%% If TypeNames is left out from the key, the cache is smaller, and
+%% the form-to-type translation is faster. But it would be a shame if,
+%% for example, any() is used, where a more complex type should be
+%% used. There is also a slight risk of creating unnecessarily big
+%% types.
+
+cache_key(Module, Name, ArgTypes, TypeNames, D) ->
+ {Module, Name, D, ArgTypes, TypeNames}.
+
+-spec cache_find(cache_key(), cache()) ->
+ {erl_type(), expand_limit()} | 'error'.
+
+cache_find(Key, #cache{types = Types}) ->
+ case maps:find(Key, Types) of
+ {ok, Value} ->
+ Value;
+ error ->
+ error
+ end.
+
+-spec cache_put(cache_key(), erl_type(), expand_limit(), cache()) -> cache().
+
+cache_put(_Key, _Type, DeltaL, Cache) when DeltaL < 0 ->
+ %% The type is truncated; do not reuse it.
+ Cache;
+cache_put(Key, Type, DeltaL, #cache{types = Types} = Cache) ->
+ NewTypes = maps:put(Key, {Type, DeltaL}, Types),
+ Cache#cache{types = NewTypes}.
+
+-spec t_var_names([parse_form()]) -> [atom()].
+
+t_var_names([{var, _, Name}|L]) when Name =/= '_' ->
+ [Name|t_var_names(L)];
+t_var_names([]) ->
+ [].
+
+-spec t_form_to_string(parse_form()) -> string().
+
+t_form_to_string({var, _L, '_'}) -> "_";
+t_form_to_string({var, _L, Name}) -> atom_to_list(Name);
+t_form_to_string({atom, _L, Atom}) ->
+ io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... '
+t_form_to_string({integer, _L, Int}) -> integer_to_list(Int);
+t_form_to_string({char, _L, Char}) -> integer_to_list(Char);
+t_form_to_string({op, _L, _Op, _Arg} = Op) ->
+ case erl_eval:partial_eval(Op) of
+ {integer, _, _} = Int -> t_form_to_string(Int);
+ _ -> io_lib:format("Badly formed type ~w", [Op])
+ end;
+t_form_to_string({op, _L, _Op, _Arg1, _Arg2} = Op) ->
+ case erl_eval:partial_eval(Op) of
+ {integer, _, _} = Int -> t_form_to_string(Int);
+ _ -> io_lib:format("Badly formed type ~w", [Op])
+ end;
+t_form_to_string({ann_type, _L, [Var, Type]}) ->
+ t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type);
+t_form_to_string({paren_type, _L, [Type]}) ->
+ flat_format("(~ts)", [t_form_to_string(Type)]);
+t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
+ ArgString = "(" ++ flat_join(t_form_to_string_list(Args), ",") ++ ")",
+ flat_format("~w:~tw", [Mod, Name]) ++ ArgString;
+t_form_to_string({type, _L, arity, []}) -> "arity()";
+t_form_to_string({type, _L, binary, []}) -> "binary()";
+t_form_to_string({type, _L, binary, [Base, Unit]} = Type) ->
+ case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
+ {{integer, _, B}, {integer, _, U}} ->
+ %% the following mirrors the clauses of t_to_string/2
+ case {U, B} of
+ {0, 0} -> "<<>>";
+ {8, 0} -> "binary()";
+ {1, 0} -> "bitstring()";
+ {0, B} -> flat_format("<<_:~w>>", [B]);
+ {U, 0} -> flat_format("<<_:_*~w>>", [U]);
+ {U, B} -> flat_format("<<_:~w,_:_*~w>>", [B, U])
+ end;
+ _ -> io_lib:format("Badly formed bitstr type ~w", [Type])
+ end;
+t_form_to_string({type, _L, bitstring, []}) -> "bitstring()";
+t_form_to_string({type, _L, 'fun', []}) -> "fun()";
+t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) ->
+ "fun(...) -> " ++ t_form_to_string(Range);
+t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) ->
+ "fun((" ++ flat_join(t_form_to_string_list(Domain), ",") ++ ") -> "
+ ++ t_form_to_string(Range) ++ ")";
+t_form_to_string({type, _L, iodata, []}) -> "iodata()";
+t_form_to_string({type, _L, iolist, []}) -> "iolist()";
+t_form_to_string({type, _L, list, [Type]}) ->
+ "[" ++ t_form_to_string(Type) ++ "]";
+t_form_to_string({type, _L, map, any}) -> "map()";
+t_form_to_string({type, _L, map, Args}) ->
+ "#{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
+t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) ->
+ t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val);
+t_form_to_string({type, _L, map_field_exact, [Key, Val]}) ->
+ t_form_to_string(Key) ++ ":=" ++ t_form_to_string(Val);
+t_form_to_string({type, _L, mfa, []}) -> "mfa()";
+t_form_to_string({type, _L, module, []}) -> "module()";
+t_form_to_string({type, _L, node, []}) -> "node()";
+t_form_to_string({type, _L, nonempty_list, [Type]}) ->
+ "[" ++ t_form_to_string(Type) ++ ",...]";
+t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()";
+t_form_to_string({type, _L, product, Elements}) ->
+ "<" ++ flat_join(t_form_to_string_list(Elements), ",") ++ ">";
+t_form_to_string({type, _L, range, [From, To]} = Type) ->
+ case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
+ {{integer, _, FromVal}, {integer, _, ToVal}} ->
+ flat_format("~w..~w", [FromVal, ToVal]);
+ _ -> flat_format("Badly formed type ~w",[Type])
+ end;
+t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
+ flat_format("#~tw{}", [Name]);
+t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
+ FieldString = flat_join(t_form_to_string_list(Fields), ","),
+ flat_format("#~tw{~ts}", [Name, FieldString]);
+t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
+ flat_format("~tw::~ts", [Name, t_form_to_string(Type)]);
+t_form_to_string({type, _L, term, []}) -> "term()";
+t_form_to_string({type, _L, timeout, []}) -> "timeout()";
+t_form_to_string({type, _L, tuple, any}) -> "tuple()";
+t_form_to_string({type, _L, tuple, Args}) ->
+ "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
+t_form_to_string({type, _L, union, Args}) ->
+ flat_join(lists:map(fun(Arg) ->
+ case Arg of
+ {ann_type, _AL, _} ->
+ "(" ++ t_form_to_string(Arg) ++ ")";
+ _ ->
+ t_form_to_string(Arg)
+ end
+ end, Args),
+ " | ");
+t_form_to_string({type, _L, Name, []} = T) ->
+ try
+ M = mod,
+ Site = {type, {M,Name,0}},
+ V = var_table__new(),
+ C = cache__new(),
+ State = #from_form{site = Site,
+ xtypes = sets:new(),
+ mrecs = 'undefined',
+ vtab = V,
+ tnames = []},
+ {T1, _, _} = from_form(T, State, _Deep=1000, _ALot=1000000, C),
+ t_to_string(T1)
+ catch throw:{error, _} -> atom_to_string(Name) ++ "()"
+ end;
+t_form_to_string({user_type, _L, Name, List}) ->
+ flat_format("~tw(~ts)",
+ [Name, flat_join(t_form_to_string_list(List), ",")]);
+t_form_to_string({type, L, Name, List}) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
+ t_form_to_string({user_type, L, Name, List}).
+
+t_form_to_string_list(List) ->
+ t_form_to_string_list(List, []).
+
+t_form_to_string_list([H|T], Acc) ->
+ t_form_to_string_list(T, [t_form_to_string(H)|Acc]);
+t_form_to_string_list([], Acc) ->
+ lists:reverse(Acc).
+
+-spec atom_to_string(atom()) -> string().
+
+atom_to_string(Atom) ->
+ flat_format("~tw", [Atom]).
+
+%%=============================================================================
+%%
+%% Utilities
+%%
+%%=============================================================================
+
+-spec any_none([erl_type()]) -> boolean().
+
+any_none([?none|_Left]) -> true;
+any_none([_|Left]) -> any_none(Left);
+any_none([]) -> false.
+
+-spec any_none_or_unit([erl_type()]) -> boolean().
+
+any_none_or_unit([?none|_]) -> true;
+any_none_or_unit([?unit|_]) -> true;
+any_none_or_unit([_|Left]) -> any_none_or_unit(Left);
+any_none_or_unit([]) -> false.
+
+-spec is_erl_type(any()) -> boolean().
+
+is_erl_type(?any) -> true;
+is_erl_type(?none) -> true;
+is_erl_type(?unit) -> true;
+is_erl_type(#c{}) -> true;
+is_erl_type(_) -> false.
+
+-spec lookup_module_types(module(), mod_type_table(), cache()) ->
+ 'error' | {type_table(), cache()}.
+
+lookup_module_types(Module, CodeTable, Cache) ->
+ #cache{mod_recs = {mrecs, MRecs}} = Cache,
+ case dict:find(Module, MRecs) of
+ {ok, R} ->
+ {R, Cache};
+ error ->
+ try ets:lookup_element(CodeTable, Module, 2) of
+ R ->
+ NewMRecs = dict:store(Module, R, MRecs),
+ {R, Cache#cache{mod_recs = {mrecs, NewMRecs}}}
+ catch
+ _:_ -> error
+ end
+ end.
+
+-spec lookup_record(atom(), type_table()) ->
+ 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
+
+lookup_record(Tag, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
+ {ok, {_FileLine, [{_Arity, Fields}]}} ->
+ {ok, Fields};
+ {ok, {_FileLine, List}} when is_list(List) ->
+ %% This will have to do, since we do not know which record we
+ %% are looking for.
+ error;
+ error ->
+ error
+ end.
+
+-spec lookup_record(atom(), arity(), type_table()) ->
+ 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
+
+lookup_record(Tag, Arity, Table) when is_atom(Tag) ->
+ case maps:find({record, Tag}, Table) of
+ {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields};
+ {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict);
+ error -> error
+ end.
+
+-spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'.
+lookup_type(Name, Arity, Table) ->
+ case maps:find({type, Name, Arity}, Table) of
+ error ->
+ case maps:find({opaque, Name, Arity}, Table) of
+ error -> error;
+ {ok, Found} -> {opaque, Found}
+ end;
+ {ok, Found} -> {type, Found}
+ end.
+
+-spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) ->
+ boolean().
+
+type_is_defined(TypeOrOpaque, Name, Arity, Table) ->
+ maps:is_key({TypeOrOpaque, Name, Arity}, Table).
+
+cannot_have_opaque(Type, TypeName, TypeNames) ->
+ t_is_none(Type) orelse is_recursive(TypeName, TypeNames).
+
+is_recursive(TypeName, TypeNames) ->
+ lists:member(TypeName, TypeNames).
+
+can_unfold_more(TypeName, TypeNames) ->
+ Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end,
+ lists:foldl(Fun, 0, TypeNames) < ?REC_TYPE_LIMIT.
+
+-spec do_opaque(erl_type(), opaques(), fun((_) -> T)) -> T.
+
+%% Probably a little faster than calling t_unopaque/2.
+%% Unions that are due to opaque types are unopaqued.
+do_opaque(?opaque(_) = Type, Opaques, Pred) ->
+ case Opaques =:= 'universe' orelse is_opaque_type(Type, Opaques) of
+ true -> do_opaque(t_opaque_structure(Type), Opaques, Pred);
+ false -> Pred(Type)
+ end;
+do_opaque(?union(List) = Type, Opaques, Pred) ->
+ [A,B,F,I,L,N,T,M,O,Map] = List,
+ if O =:= ?none -> Pred(Type);
+ true ->
+ case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of
+ true ->
+ S = t_opaque_structure(O),
+ do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred);
+ false -> Pred(Type)
+ end
+ end;
+do_opaque(Type, _Opaques, Pred) ->
+ Pred(Type).
+
+map_all_values(?map(Pairs,_,DefV)) ->
+ [DefV|[V || {V, _, _} <- Pairs]].
+
+map_all_keys(?map(Pairs,DefK,_)) ->
+ [DefK|[K || {_, _, K} <- Pairs]].
+
+map_all_types(M) ->
+ map_all_keys(M) ++ map_all_values(M).
+
+%% Tests if a type has exactly one possible value.
+-spec t_is_singleton(erl_type()) -> boolean().
+
+t_is_singleton(Type) ->
+ t_is_singleton(Type, 'universe').
+
+-spec t_is_singleton(erl_type(), opaques()) -> boolean().
+
+t_is_singleton(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun is_singleton_type/1).
+
+%% To be in sync with separate_key/1.
+%% Used to also recognize maps and tuples.
+is_singleton_type(?nil) -> true;
+is_singleton_type(?atom(?any)) -> false;
+is_singleton_type(?atom(Set)) ->
+ ordsets:size(Set) =:= 1;
+is_singleton_type(?int_range(V, V)) -> true;
+is_singleton_type(?int_set(Set)) ->
+ ordsets:size(Set) =:= 1;
+is_singleton_type(_) ->
+ false.
+
+%% Returns the only possible value of a singleton type.
+-spec t_singleton_to_term(erl_type(), opaques()) -> term().
+
+t_singleton_to_term(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun singleton_type_to_term/1).
+
+singleton_type_to_term(?nil) -> [];
+singleton_type_to_term(?atom(Set)) when Set =/= ?any ->
+ case ordsets:size(Set) of
+ 1 -> hd(ordsets:to_list(Set));
+ _ -> error(badarg)
+ end;
+singleton_type_to_term(?int_range(V, V)) -> V;
+singleton_type_to_term(?int_set(Set)) ->
+ case ordsets:size(Set) of
+ 1 -> hd(ordsets:to_list(Set));
+ _ -> error(badarg)
+ end;
+singleton_type_to_term(?tuple(Types, Arity, _)) when is_integer(Arity) ->
+ lists:map(fun singleton_type_to_term/1, Types);
+singleton_type_to_term(?tuple_set([{Arity, [OnlyTuple]}]))
+ when is_integer(Arity) ->
+ singleton_type_to_term(OnlyTuple);
+singleton_type_to_term(?map(Pairs, ?none, ?none)) ->
+ maps:from_list([{singleton_type_to_term(K), singleton_type_to_term(V)}
+ || {K,?mand,V} <- Pairs]).
+
+%% -----------------------------------
+%% Set
+%%
+
+set_singleton(Element) ->
+ ordsets:from_list([Element]).
+
+set_is_singleton(Element, Set) ->
+ set_singleton(Element) =:= Set.
+
+set_is_element(Element, Set) ->
+ ordsets:is_element(Element, Set).
+
+set_union(?any, _) -> ?any;
+set_union(_, ?any) -> ?any;
+set_union(S1, S2) ->
+ case ordsets:union(S1, S2) of
+ S when length(S) =< ?SET_LIMIT -> S;
+ _ -> ?any
+ end.
+
+%% The intersection and subtraction can return ?none.
+%% This should always be handled right away since ?none is not a valid set.
+%% However, ?any is considered a valid set.
+
+set_intersection(?any, S) -> S;
+set_intersection(S, ?any) -> S;
+set_intersection(S1, S2) ->
+ case ordsets:intersection(S1, S2) of
+ [] -> ?none;
+ S -> S
+ end.
+
+set_subtract(_, ?any) -> ?none;
+set_subtract(?any, _) -> ?any;
+set_subtract(S1, S2) ->
+ case ordsets:subtract(S1, S2) of
+ [] -> ?none;
+ S -> S
+ end.
+
+set_from_list(List) ->
+ case length(List) of
+ L when L =< ?SET_LIMIT -> ordsets:from_list(List);
+ L when L > ?SET_LIMIT -> ?any
+ end.
+
+set_to_list(Set) ->
+ ordsets:to_list(Set).
+
+set_filter(Fun, Set) ->
+ case ordsets:filter(Fun, Set) of
+ [] -> ?none;
+ NewSet -> NewSet
+ end.
+
+set_size(Set) ->
+ ordsets:size(Set).
+
+set_to_string(Set) ->
+ L = [case is_atom(X) of
+ true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs '
+ false -> flat_format("~tw", [X])
+ end || X <- set_to_list(Set)],
+ flat_join(L, " | ").
+
+set_min([H|_]) -> H.
+
+set_max(Set) ->
+ hd(lists:reverse(Set)).
+
+flat_format(F, S) ->
+ lists:flatten(io_lib:format(F, S)).
+
+flat_join(List, Sep) ->
+ lists:flatten(lists:join(Sep, List)).
+
+%%=============================================================================
+%%
+%% Utilities for the binary type
+%%
+%%=============================================================================
+
+-spec gcd(integer(), integer()) -> integer().
+
+gcd(A, B) when B > A ->
+ gcd1(B, A);
+gcd(A, B) ->
+ gcd1(A, B).
+
+-spec gcd1(integer(), integer()) -> integer().
+
+gcd1(A, 0) -> A;
+gcd1(A, B) ->
+ case A rem B of
+ 0 -> B;
+ X -> gcd1(B, X)
+ end.
+
+-spec bitstr_concat(erl_type(), erl_type()) -> erl_type().
+
+bitstr_concat(?none, _) -> ?none;
+bitstr_concat(_, ?none) -> ?none;
+bitstr_concat(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(gcd(U1, U2), B1+B2).
+
+-spec bitstr_match(erl_type(), erl_type()) -> erl_type().
+
+bitstr_match(?none, _) -> ?none;
+bitstr_match(_, ?none) -> ?none;
+bitstr_match(?bitstr(0, B1), ?bitstr(0, B2)) when B1 =< B2 ->
+ t_bitstr(0, B2-B1);
+bitstr_match(?bitstr(0, _B1), ?bitstr(0, _B2)) ->
+ ?none;
+bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) when B1 =< B2 ->
+ t_bitstr(U2, B2-B1);
+bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) ->
+ t_bitstr(U2, handle_base(U2, B2-B1));
+bitstr_match(?bitstr(_, B1), ?bitstr(0, B2)) when B1 > B2 ->
+ ?none;
+bitstr_match(?bitstr(U1, B1), ?bitstr(U2, B2)) ->
+ GCD = gcd(U1, U2),
+ t_bitstr(GCD, handle_base(GCD, B2-B1)).
+
+-spec handle_base(integer(), integer()) -> integer().
+
+handle_base(Unit, Pos) when Pos >= 0 ->
+ Pos rem Unit;
+handle_base(Unit, Neg) ->
+ (Unit+(Neg rem Unit)) rem Unit.
+
+family(L) ->
+ R = sofs:relation(L),
+ F = sofs:relation_to_family(R),
+ sofs:to_external(F).
+
+%%=============================================================================
+%%
+%% Interface functions for abstract data types defined in this module
+%%
+%%=============================================================================
+
+-spec var_table__new() -> var_table().
+
+var_table__new() ->
+ maps:new().
diff --git a/lib/dialyzer/test/Makefile b/lib/dialyzer/test/Makefile
index 43c8a61ce1..d5e975453f 100644
--- a/lib/dialyzer/test/Makefile
+++ b/lib/dialyzer/test/Makefile
@@ -14,7 +14,8 @@ AUXILIARY_FILES=\
dialyzer_SUITE.erl\
abstract_SUITE.erl\
plt_SUITE.erl\
- typer_SUITE.erl
+ typer_SUITE.erl\
+ erl_types_SUITE.erl
# ----------------------------------------------------
# Release directory specification
diff --git a/lib/dialyzer/test/erl_types_SUITE.erl b/lib/dialyzer/test/erl_types_SUITE.erl
new file mode 100644
index 0000000000..7d7c144b69
--- /dev/null
+++ b/lib/dialyzer/test/erl_types_SUITE.erl
@@ -0,0 +1,197 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% 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.
+%%
+-module(erl_types_SUITE).
+
+-export([all/0,
+ consistency_and_to_string/1]).
+
+%% Simplify calls into erl_types and avoid importing the entire module.
+-define(M, erl_types).
+
+-include_lib("common_test/include/ct.hrl").
+
+all() ->
+ [consistency_and_to_string].
+
+consistency_and_to_string(_Config) ->
+ %% Check consistency of types
+ Atom1 = ?M:t_atom(),
+ Atom2 = ?M:t_atom(foo),
+ Atom3 = ?M:t_atom(bar),
+ true = ?M:t_is_atom(Atom2),
+
+ True = ?M:t_atom(true),
+ False = ?M:t_atom(false),
+ Bool = ?M:t_boolean(),
+ true = ?M:t_is_boolean(True),
+ true = ?M:t_is_boolean(Bool),
+ false = ?M:t_is_boolean(Atom1),
+
+ Binary = ?M:t_binary(),
+ true = ?M:t_is_binary(Binary),
+
+ Bitstr = ?M:t_bitstr(),
+ true = ?M:t_is_bitstr(Bitstr),
+
+ Bitstr1 = ?M:t_bitstr(7, 3),
+ true = ?M:t_is_bitstr(Bitstr1),
+ false = ?M:t_is_binary(Bitstr1),
+
+ Bitstr2 = ?M:t_bitstr(16, 8),
+ true = ?M:t_is_bitstr(Bitstr2),
+ true = ?M:t_is_binary(Bitstr2),
+
+ BitStr816 = ?M:t_bitstr(8,16),
+ BitStr816 = ?M:t_subtract(?M:t_bitstr(4, 12), ?M:t_bitstr(8, 12)),
+
+ Int1 = ?M:t_integer(),
+ Int2 = ?M:t_integer(1),
+ Int3 = ?M:t_integer(16#ffffffff),
+ true = ?M:t_is_integer(Int2),
+ true = ?M:t_is_byte(Int2),
+ false = ?M:t_is_byte(Int3),
+ false = ?M:t_is_byte(?M:t_from_range(-1, 1)),
+ true = ?M:t_is_byte(?M:t_from_range(1, 255)),
+
+ Tuple1 = ?M:t_tuple(),
+ Tuple2 = ?M:t_tuple(3),
+ Tuple3 = ?M:t_tuple([Atom1, Int1]),
+ Tuple4 = ?M:t_tuple([Tuple1, Tuple2]),
+ Tuple5 = ?M:t_tuple([Tuple3, Tuple4]),
+ Tuple6 = ?M:t_limit(Tuple5, 2),
+ Tuple7 = ?M:t_limit(Tuple5, 3),
+ true = ?M:t_is_tuple(Tuple1),
+
+ Port = ?M:t_port(),
+ Pid = ?M:t_pid(),
+ Ref = ?M:t_reference(),
+ Identifier = ?M:t_identifier(),
+ false = ?M:t_is_reference(Port),
+ true = ?M:t_is_identifier(Port),
+
+ Function1 = ?M:t_fun(),
+ Function2 = ?M:t_fun(Pid),
+ Function3 = ?M:t_fun([], Pid),
+ Function4 = ?M:t_fun([Port, Pid], Pid),
+ Function5 = ?M:t_fun([Pid, Atom1], Int2),
+ true = ?M:t_is_fun(Function3),
+
+ List1 = ?M:t_list(),
+ List2 = ?M:t_list(?M:t_boolean()),
+ List3 = ?M:t_cons(?M:t_boolean(), List2),
+ List4 = ?M:t_cons(?M:t_boolean(), ?M:t_atom()),
+ List5 = ?M:t_cons(?M:t_boolean(), ?M:t_nil()),
+ List6 = ?M:t_cons_tl(List5),
+ List7 = ?M:t_sup(List4, List5),
+ List8 = ?M:t_inf(List7, ?M:t_list()),
+ List9 = ?M:t_cons(),
+ List10 = ?M:t_cons_tl(List9),
+ true = ?M:t_is_boolean(?M:t_cons_hd(List5)),
+ true = ?M:t_is_list(List5),
+ false = ?M:t_is_list(List4),
+
+ Product1 = ?M:t_product([Atom1, Atom2]),
+ Product2 = ?M:t_product([Atom3, Atom1]),
+ Product3 = ?M:t_product([Atom3, Atom2]),
+
+ Union1 = ?M:t_sup(Atom2, Atom3),
+ Union2 = ?M:t_sup(Tuple2, Tuple3),
+ Union3 = ?M:t_sup(Int2, Atom3),
+ Union4 = ?M:t_sup(Port, Pid),
+ Union5 = ?M:t_sup(Union4, Int1),
+ Union6 = ?M:t_sup(Function1, Function2),
+ Union7 = ?M:t_sup(Function4, Function5),
+ Union8 = ?M:t_sup(True, False),
+ true = ?M:t_is_boolean(Union8),
+ Union9 = ?M:t_sup(Int2, ?M:t_integer(2)),
+ true = ?M:t_is_byte(Union9),
+ Union10 = ?M:t_sup(?M:t_tuple([?M:t_atom(true), ?M:t_any()]),
+ ?M:t_tuple([?M:t_atom(false), ?M:t_any()])),
+
+ Any = ?M:t_any(),
+ Any = ?M:t_sup(Product3, Function5),
+
+ Atom3 = ?M:t_inf(Union3, Atom1),
+ Union2 = ?M:t_inf(Union2, Tuple1),
+ Int2 = ?M:t_inf(Int1, Union3),
+ Union4 = ?M:t_inf(Union4, Identifier),
+ Port = ?M:t_inf(Union5, Port),
+ Function4 = ?M:t_inf(Union7, Function4),
+ None = ?M:t_none(),
+ None = ?M:t_inf(Product2, Atom1),
+ Product3 = ?M:t_inf(Product1, Product2),
+ Function5 = ?M:t_inf(Union7, Function5),
+ true = ?M:t_is_byte(?M:t_inf(Union9, ?M:t_number())),
+ true = ?M:t_is_char(?M:t_inf(Union9, ?M:t_number())),
+
+ RecDict = #{{record, foo} => {{?FILE, ?LINE}, [{2, [{bar, [], ?M:t_any()},
+ {baz, [], ?M:t_any()}]}]}},
+ Record1 = ?M:t_from_term({foo, [1,2], {1,2,3}}),
+
+ %% Check string representations
+ "atom()" = ?M:t_to_string(Atom1),
+ "'foo'" = ?M:t_to_string(Atom2),
+ "'bar'" = ?M:t_to_string(Atom3),
+
+ "binary()" = ?M:t_to_string(Binary),
+
+ "integer()" = ?M:t_to_string(Int1),
+ "1" = ?M:t_to_string(Int2),
+
+ "tuple()" = ?M:t_to_string(Tuple1),
+ "{_,_,_}" = ?M:t_to_string(Tuple2),
+ "{atom(),integer()}" = ?M:t_to_string(Tuple3),
+ "{tuple(),{_,_,_}}" = ?M:t_to_string(Tuple4),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple5),
+ "{{_,_},{_,_}}" = ?M:t_to_string(Tuple6),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple7),
+
+ "reference()" = ?M:t_to_string(Ref),
+ "port()" = ?M:t_to_string(Port),
+ "pid()" = ?M:t_to_string(Pid),
+ "identifier()" = ?M:t_to_string(Identifier),
+
+ "[any()]" = ?M:t_to_string(List1),
+ "[boolean()]" = ?M:t_to_string(List2),
+ "[boolean(),...]" = ?M:t_to_string(List3),
+ "nonempty_improper_list(boolean(),atom())" = ?M:t_to_string(List4),
+ "[boolean(),...]" = ?M:t_to_string(List5),
+ "[boolean()]" = ?M:t_to_string(List6),
+ "nonempty_maybe_improper_list(boolean(),atom() | [])" = ?M:t_to_string(List7),
+ "[boolean(),...]" = ?M:t_to_string(List8),
+ "nonempty_maybe_improper_list()" = ?M:t_to_string(List9),
+ "any()" = ?M:t_to_string(List10),
+
+ "fun()" = ?M:t_to_string(Function1),
+ "fun((...) -> pid())" = ?M:t_to_string(Function2),
+ "fun(() -> pid())" = ?M:t_to_string(Function3),
+ "fun((port(),pid()) -> pid())" = ?M:t_to_string(Function4),
+ "fun((pid(),atom()) -> 1)" = ?M:t_to_string(Function5),
+
+ "<atom(),'foo'>" = ?M:t_to_string(Product1),
+ "<'bar',atom()>" = ?M:t_to_string(Product2),
+
+ "#foo{bar::[1 | 2,...],baz::{1,2,3}}" = ?M:t_to_string(Record1, RecDict),
+
+ "'bar' | 'foo'" = ?M:t_to_string(Union1),
+ "{atom(),integer()} | {_,_,_}" = ?M:t_to_string(Union2),
+ "'bar' | 1" = ?M:t_to_string(Union3),
+ "pid() | port()" = ?M:t_to_string(Union4),
+ "pid() | port() | integer()" = ?M:t_to_string(Union5),
+ "fun()" = ?M:t_to_string(Union6),
+ "fun((pid() | port(),atom() | pid()) -> pid() | 1)" = ?M:t_to_string(Union7),
+ "boolean()" = ?M:t_to_string(Union8),
+ "{'false',_} | {'true',_}" = ?M:t_to_string(Union10),
+ "{'true',integer()}" = ?M:t_to_string(?M:t_inf(Union10, ?M:t_tuple([?M:t_atom(true), ?M:t_integer()]))).