The R13B03 release.OTP_R13B03

14 files changed, 18304 insertions, 0 deletions

diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile
new file mode 100644
index 0000000000..fb7ca1153b
--- /dev/null
+++ b/lib/hipe/cerl/Makefile
@@ -0,0 +1,107 @@
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_hybrid_transform \
+	  cerl_lib cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \
+	  cerl_typean erl_bif_types erl_types 
+
+HRL_FILES= cerl_hipe_primops.hrl
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE= 
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE= 
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +inline +warn_exported_vars +warn_unused_import +warn_missing_spec# +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES) 
+
+docs: $(DOC_FILES)
+
+clean:
+	rm -f $(TARGET_FILES)
+	rm -f core
+
+$(DOCS)/%.html:%.erl
+	erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ---------------------------------------------------- 
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+	$(INSTALL_DIR) $(RELSYSDIR)/cerl
+	$(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/cerl
+	$(INSTALL_DIR) $(RELSYSDIR)/ebin
+	$(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl
+$(EBIN)/cerl_hipeify.beam: cerl_hipe_primops.hrl
+$(EBIN)/cerl_lambdalift.beam: cerl_hipe_primops.hrl
+$(EBIN)/erl_bif_types.beam: ../icode/hipe_icode_primops.hrl
diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl
new file mode 100644
index 0000000000..cf4d317b0d
--- /dev/null
+++ b/lib/hipe/cerl/cerl_cconv.erl
@@ -0,0 +1,777 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2000-2004 Richard Carlsson
+%% @doc Closure conversion of Core Erlang modules. This is done as a
+%% step in the translation from Core Erlang down to HiPE Icode, and is
+%% very much tied to the calling conventions used in HiPE native code.
+%% @see cerl_to_icode
+
+%% Some information about function closures in Beam and HiPE:
+%%
+%% - In Beam, each fun-expression is lifted to a top-level function such
+%%   that the arity of the new function is equal to the arity of the fun
+%%   *plus* the number of free variables. The original fun-expression is
+%%   replaced by a call to 'make_fun' which takes the *label* of the new
+%%   function and the number of free variables as arguments (the arity
+%%   of the fun can be found via the label). When a call is made through
+%%   the closure, the free variables are extracted from the closure by
+%%   the 'call_fun' operation and are placed in the X registers
+%%   following the ones used for the normal parameters; then the call is
+%%   made to the function label.
+%%
+%% - In HiPE (when compiling from Beam bytecode), the Beam-to-Icode
+%%   translation rewrites the fun-functions (those referenced by
+%%   'make_fun' operations) so that the code expects only the normal
+%%   parameters, plus *one* extra parameter containing the closure
+%%   itself, and then immediately extracts the free variables from the
+%%   closure - the code knows how many free variables it expects.
+%%   However, the arity part of the function name is *not* changed;
+%%   thus, the native code and the Beam code still use the same
+%%   fun-table entry. The arity value used in native-code 'make_fun'
+%%   operations should therefore be the same as in Beam, i.e., the sum
+%%   of the number of parameters and the number of free variables.
+
+-module(cerl_cconv).
+
+-export([transform/2]).
+-export([core_transform/2]).
+
+-include("cerl_hipe_primops.hrl").
+
+%% A descriptor for top-level and letrec-bound functions. (Top-level
+%% functions always have an empty list of free variables.) The 'name'
+%% field is the name of the lifted function, and is thus unique over the
+%% whole module.
+
+-record(function, {name :: {atom(), arity()}, free}).
+
+%% A record for holding fun-information (if such information is attached
+%% as an annotation on a fun, it should preferably be preserved).
+
+-record(fun_info, {name     :: atom(),
+		   id   = 0 :: integer(),
+		   hash = 0 :: integer()}).
+
+%% @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_cconv}</code>
+%% to insert this function as a compilation pass.</p>
+%%
+%% @see transform/2
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(M, Opts) ->
+    cerl:to_records(transform(cerl:from_records(M), Opts)).
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%%    cerl() = cerl:cerl()
+%%
+%% @doc Rewrites a Core Erlang module so that all fun-expressions
+%% (lambda expressions) in the code are in top level function
+%% definitions, and the operators of all `apply'-expressions are names
+%% of such top-level functions. The primitive operations `make_fun' and
+%% `call_fun' are inserted in the code to create and apply functional
+%% values; this transformation is known as "Closure Conversion"
+%%
+%% <p>See the module {@link cerl_to_icode} for details.</p>
+
+-spec transform(cerl:c_module(), [term()]) -> cerl:c_module().
+
+transform(E, _Options) ->
+    M = cerl:module_name(E),
+    S0 = s__new(cerl:atom_val(M)),
+    {Defs1, S1} = module_defs(cerl:module_defs(E), env__new(),
+			      ren__new(), S0),
+    Defs2 = lists:reverse(s__get_defs(S1) ++ Defs1),
+    cerl:update_c_module(E, M, cerl:module_exports(E),
+			 cerl:module_attrs(E), Defs2).
+
+%% Note that the environment is defined on the renamed variables.
+
+expr(E, Env, Ren, S0) ->
+    case cerl:type(E) of
+ 	literal ->
+	    {E, S0};
+	var ->
+	    var(E, Env, Ren, S0);
+	values ->
+	    {Es, S1} = expr_list(cerl:values_es(E), Env, Ren, S0),
+ 	    {cerl:update_c_values(E, Es), S1};
+	cons ->
+	    {E1, S1} = expr(cerl:cons_hd(E), Env, Ren, S0),
+	    {E2, S2} = expr(cerl:cons_tl(E), Env, Ren, S1),
+	    {cerl:update_c_cons(E, E1, E2), S2};
+ 	tuple ->
+	    {Es, S1} = expr_list(cerl:tuple_es(E), Env, Ren, S0),
+	    {cerl:update_c_tuple(E, Es), S1};
+ 	'let' ->
+	    {A, S1} = expr(cerl:let_arg(E), Env, Ren, S0),
+	    Vs = cerl:let_vars(E),
+	    {Vs1, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+	    {B, S2} = expr(cerl:let_body(E), Env1, Ren1, S1),
+	    {cerl:update_c_let(E, Vs1, A, B), S2};
+	seq ->
+	    {A, S1} = expr(cerl:seq_arg(E), Env, Ren, S0),
+	    {B, S2} = expr(cerl:seq_body(E), Env, Ren, S1),
+ 	    {cerl:update_c_seq(E, A, B), S2};
+ 	apply ->
+	    apply_expr(E, Env, Ren, S0);
+ 	call ->
+	    {M, S1} = expr(cerl:call_module(E), Env, Ren, S0),
+	    {N, S2} = expr(cerl:call_name(E), Env, Ren, S1),
+	    {As, S3} = expr_list(cerl:call_args(E), Env, Ren, S2),
+ 	    {cerl:update_c_call(E, M, N, As), S3};
+ 	primop ->
+	    {As, S1} = expr_list(cerl:primop_args(E), Env, Ren, S0),
+	    N = cerl:primop_name(E),
+	    {cerl:update_c_primop(E, N, As), S1};
+ 	'case' ->
+	    {A, S1} = expr(cerl:case_arg(E), Env, Ren, S0),
+	    {Cs, S2} = expr_list(cerl:case_clauses(E), Env, Ren, S1),
+ 	    {cerl:update_c_case(E, A, Cs), S2};
+ 	clause ->
+	    Vs = cerl:clause_vars(E),
+	    {_, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+	    %% Visit patterns to rename variables.
+	    Ps = pattern_list(cerl:clause_pats(E), Env1, Ren1),
+	    {G, S1} = expr(cerl:clause_guard(E), Env1, Ren1, S0),
+	    {B, S2} = expr(cerl:clause_body(E), Env1, Ren1, S1),
+	    {cerl:update_c_clause(E, Ps, G, B), S2};
+ 	'fun' ->
+	    fun_expr(E, Env, Ren, S0);
+ 	'receive' ->
+	    {Cs, S1} = expr_list(cerl:receive_clauses(E), Env, Ren, S0),
+	    {T, S2} = expr(cerl:receive_timeout(E), Env, Ren, S1),
+	    {A, S3} = expr(cerl:receive_action(E), Env, Ren, S2),
+	    {cerl:update_c_receive(E, Cs, T, A), S3};
+ 	'try' ->
+	    {A, S1} = expr(cerl:try_arg(E), Env, Ren, S0),
+	    Vs = cerl:try_vars(E),
+	    {Vs1, Env1, Ren1} = bind_vars(Vs, Env, Ren),
+	    {B, S2} = expr(cerl:try_body(E), Env1, Ren1, S1),
+	    Evs = cerl:try_evars(E),
+	    {Evs1, Env2, Ren2} = bind_vars(Evs, Env, Ren),
+	    {H, S3} = expr(cerl:try_handler(E), Env2, Ren2, S2),
+	    {cerl:update_c_try(E, A, Vs1, B, Evs1, H), S3};
+ 	'catch' ->
+	    {B, S1} = expr(cerl:catch_body(E), Env, Ren, S0),
+	    {cerl:update_c_catch(E, B), S1};
+	letrec ->
+	    {Env1, Ren1, S1} = letrec_defs(cerl:letrec_defs(E), Env,
+					   Ren, S0),
+	    expr(cerl:letrec_body(E), Env1, Ren1, S1);
+        binary ->
+	    {Segs, S1} = expr_list(cerl:binary_segments(E), Env, Ren, S0),
+	    {cerl:update_c_binary(E, Segs),S1};
+	bitstr ->
+	    {E1,S1} = expr(cerl:bitstr_val(E), Env, Ren, S0),
+	    {E2,S2} = expr(cerl:bitstr_size(E), Env, Ren, S1),	
+	    E3 = cerl:bitstr_unit(E), 
+	    E4 = cerl:bitstr_type(E),
+	    E5 = cerl:bitstr_flags(E),
+	    {cerl:update_c_bitstr(E, E1, E2, E3, E4, E5), S2}
+    end.
+
+expr_list([E | Es], Env, Ren, S0) ->
+    {E1, S1} = expr(E, Env, Ren, S0),
+    {Es1, S2} = expr_list(Es, Env, Ren, S1),
+    {[E1 | Es1], S2};
+expr_list([], _, _, S) ->
+    {[], S}.
+
+pattern(E, Env, Ren) ->
+    case cerl:type(E) of
+ 	literal ->
+	    E;
+	var ->
+	    cerl:update_c_var(E, ren__map(cerl:var_name(E), Ren));
+	values ->
+	    Es = pattern_list(cerl:values_es(E), Env, Ren),
+ 	    cerl:update_c_values(E, Es);
+	cons ->
+	    E1 = pattern(cerl:cons_hd(E), Env, Ren),
+	    E2 = pattern(cerl:cons_tl(E), Env, Ren),
+	    cerl:update_c_cons(E, E1, E2);
+ 	tuple ->
+	    Es = pattern_list(cerl:tuple_es(E), Env, Ren),
+	    cerl:update_c_tuple(E, Es);
+	binary ->
+	    Es = pattern_list(cerl:binary_segments(E), Env, Ren),
+	    cerl:update_c_binary(E, Es);
+	bitstr ->
+	    E1 = pattern(cerl:bitstr_val(E), Env, Ren),
+	    E2 = pattern(cerl:bitstr_size(E), Env, Ren),	
+	    E3 = cerl:bitstr_unit(E), 
+	    E4 = cerl:bitstr_type(E),
+	    E5 = cerl:bitstr_flags(E),
+	    cerl:update_c_bitstr(E, E1, E2, E3, E4, E5);
+	alias ->
+	    V = pattern(cerl:alias_var(E), Env, Ren),
+	    P = pattern(cerl:alias_pat(E), Env, Ren),
+	    cerl:update_c_alias(E, V, P)
+    end.
+
+pattern_list([E | Es], Env, Ren) ->
+    [pattern(E, Env, Ren) | pattern_list(Es, Env, Ren)];
+pattern_list([], _, _) ->
+    [].
+
+%% First we set up the environment, binding the function names to the
+%% corresponding descriptors. (For the top level functions, we don't
+%% want to cause renaming.) After that, we can visit each function body
+%% and return the new function definitions and the final state.
+
+module_defs(Ds, Env, Ren, S) ->
+    {Env1, S1} = bind_module_defs(Ds, Env, S),
+    module_defs_1(Ds, [], Env1, Ren, S1).
+
+bind_module_defs([{V, _F} | Ds], Env, S) ->
+    Name = cerl:var_name(V),
+    check_function_name(Name, S),
+    S1 = s__add_function_name(Name, S),
+    Info = #function{name = Name, free = []},
+    Env1 = env__bind(Name, Info, Env),
+    bind_module_defs(Ds, Env1, S1);
+bind_module_defs([], Env, S) ->
+    {Env, S}.
+
+%% Checking that top-level function names are not reused
+
+check_function_name(Name, S) ->
+    case s__is_function_name(Name, S) of
+	true ->
+	    error_msg("multiple definitions of function `~w'.", [Name]),
+	    exit(error);
+	false ->
+	    ok
+    end.
+
+%% We must track which top-level function we are in, for name generation
+%% purposes.
+
+module_defs_1([{V, F} | Ds], Ds1, Env, Ren, S) ->
+    S1 = s__enter_function(cerl:var_name(V), S),
+    %% The parameters should never need renaming, but this is easiest.
+    {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+    {B, S2} = expr(cerl:fun_body(F), Env1, Ren1, S1),
+    F1 = cerl:update_c_fun(F, Vs, B),
+    module_defs_1(Ds, [{V, F1} | Ds1], Env, Ren, S2);
+module_defs_1([], Ds, _, _, S) ->
+    {Ds, S}.
+
+%% First we must create the new function names and set up the
+%% environment with descriptors for the letrec-bound functions.
+%%
+%% Since we never shadow variables, the free variables of any
+%% letrec-bound fun can always be referenced directly wherever the
+%% fun-variable itself is referenced - this is important when we create
+%% direct calls to lifted letrec-bound functions, and is the main reason
+%% why we do renaming. For example:
+%%
+%%   'f'/0 = fun () ->
+%%             let X = 42 in
+%%               letrec 'g'/1 = fun (Y) -> {X, Y} in
+%%                 let X = 17 in
+%%                   apply 'g'/1(X)
+%%
+%% will become something like
+%%
+%%   'f'/0 = fun () ->
+%%             let X = 42 in
+%%               let X1 = 17 in
+%%                 apply 'g'/2(X1, X)
+%%   'g'/2 = fun (Y, X) -> {X, Y}
+%%
+%% where the innermost X has been renamed so that the outermost X can be
+%% referenced in the call to the lifted function 'g'/2. (Renaming must
+%% of course also be applied also to letrec-bound function variables.)
+%%
+%% Furthermore, if some variable X occurs free in a fun 'f'/N, and 'f'/N
+%% it its turn occurs free in a fun 'g'/M, then we transitively count X
+%% as free in 'g'/M, even if it has no occurrence there. This allows us
+%% to rewrite code such as the following:
+%%
+%%   'f'/0 = fun () ->
+%%             let X = 42 in
+%%               letrec 'g'/1 = fun (Y) -> {X, Y}
+%%                      'h'/1 = fun (Z) -> {'bar', apply 'g'/1(Z)}
+%%               in let X = 17 in
+%%                    apply 'h'/1(X)
+%%
+%% into something like:
+%%
+%%   'f'/0 = fun () ->
+%%             let X = 42 in
+%%               let X1 = 17 in
+%%                 apply 'h'/2(X1, X)
+%%   'g'/2 = fun (Y, X) -> {X, Y}
+%%   'h'/2 = fun (Z, X) -> {'bar', apply 'g'/2(Z, X)}
+%%
+%% which uses only direct calls. The drawback is that if the occurrence
+%% of 'f'/N in 'g'/M instead would cause a closure to be created, then
+%% that closure could have been formed earlier (at the point where 'f'/N
+%% was defined), rather than passing on all the free variables of 'f'/N
+%% into 'g'/M. Since we must know the interface to 'g'/M (i.e., the
+%% total number of parameters) before we begin processing its body, and
+%% the interface depends on what we do to the body (and functions can be
+%% mutually recursive), this problem can only be solved by finding out
+%% _what_ we are going to do before we can even define the interfaces of
+%% the functions, by looking at _how_ variables are being referenced
+%% when we look for free variables. Currently, we don't do that.
+
+letrec_defs(Ds, Env, Ren, S) ->
+    {Env1, Ren1, S1} = bind_letrec_defs(Ds, Env, Ren, S),
+    {Env1, Ren1, lift_letrec_defs(Ds, Env1, Ren1, S1)}.
+
+%% Note: it is important that we store the *renamed* free variables for
+%% each function to be lifted.
+
+bind_letrec_defs(Ds, Env, Ren, S) ->
+    bind_letrec_defs(Ds, free_in_defs(Ds, Env, Ren), Env, Ren, S).
+
+bind_letrec_defs([{V, _F} | Ds], Free, Env, Ren, S) ->
+    Name = cerl:var_name(V),
+    {Env1, Ren1, S1} = bind_letrec_fun(Name, Free, Env, Ren, S),
+    bind_letrec_defs(Ds, Free, Env1, Ren1, S1);
+bind_letrec_defs([], _Free, Env, Ren, S) ->
+    {Env, Ren, S}.
+
+bind_letrec_fun(Name = {_,A}, Free, Env, Ren, S) ->
+    A1 = A + length(Free),
+    {Name1, Ren1, S1} = rename_letrec_fun(Name, A1, Env, Ren, S),
+    Info = #function{name = Name1, free = Free},
+    {env__bind(Name1, Info, Env), Ren1, S1}.
+
+%% Creating a new name for the lifted function that is informative, is
+%% not in the environment, and is not already used for some other lifted
+%% function.
+
+rename_letrec_fun(Name, NewArity, Env, Ren, S) ->
+    {New, S1} = new_letrec_fun_name(Name, NewArity, Env, S),
+    {New, ren__add(Name, New, Ren), s__add_function_name(New, S1)}.
+
+new_letrec_fun_name({N,_}, Arity, Env, S) ->
+    {FName, FArity} = s__get_function(S),
+    Base = fun_name_base(FName, FArity)
+	++ "-letrec-" ++ atom_to_list(N) ++ "-",
+    %% We try the base as name first. This will usually work.
+    Name = {list_to_atom(Base), Arity},
+    case env__is_defined(Name, Env) of
+	true ->
+	    new_fun_name(Base, Arity, Env, S);
+	false ->
+	    case s__is_function_name(Name, S) of
+		true ->
+		    new_fun_name(Base, Arity, Env, S);
+		false ->
+		    {Name, S}
+	    end
+    end.
+
+%% Processing the actual functions of a letrec
+
+lift_letrec_defs([{V, F} | Ds], Env, Ren, S) ->
+    Info = env__get(ren__map(cerl:var_name(V), Ren), Env),
+    S1 = lift_letrec_fun(F, Info, Env, Ren, S),
+    lift_letrec_defs(Ds, Env, Ren, S1);
+lift_letrec_defs([], _, _, S) ->
+    S.
+
+%% The direct calling convention for letrec-defined functions is to pass
+%% the free variables as additional parameters. Note that the free
+%% variables (if any) are already in the environment when we get here.
+%% We only have to append them to the parameter list so that they are in
+%% scope in the lifted function; they are already renamed.
+%%
+%% It should not be possible for the original parameters to clash with
+%% the free ones (in that case they cannot be free), but we do the full
+%% bind-and-rename anyway, since it's easiest.
+
+lift_letrec_fun(F, Info, Env, Ren, S) ->
+    {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+    {B, S1} = expr(cerl:fun_body(F), Env1, Ren1, S),
+    Fs = [cerl:c_var(V) || V <- Info#function.free],
+    F1 = cerl:c_fun(Vs ++ Fs, B),
+    s__add_def(cerl:c_var(Info#function.name), F1, S1).
+
+%% This is a simple way of handling mutual recursion in a group of
+%% letrec-definitions: classify a variable as free in all the functions
+%% if it is free in any of them. (The preferred way would be to actually
+%% take the transitive closure for each function.)
+
+free_in_defs(Ds, Env, Ren) ->
+    {Vs, Fs} = free_in_defs(Ds, [], [], Ren),
+    closure_vars(ordsets:subtract(Fs, Vs), Env, Ren).
+
+free_in_defs([{V, F} | Ds], Vs, Free, Ren) ->
+    Fs = cerl_trees:free_variables(F),
+    free_in_defs(Ds, [ren__map(cerl:var_name(V), Ren) | Vs], Fs ++ Free,
+		 Ren);
+free_in_defs([], Vs, Free, _Ren) ->
+    {ordsets:from_list(Vs), ordsets:from_list(Free)}.
+
+%% Replacing function variables with the free variables of the function
+
+closure_vars(Vs, Env, Ren) ->
+    closure_vars(Vs, [], Env, Ren).
+
+closure_vars([V = {_, _} | Vs], As, Env, Ren) ->
+    V1 = ren__map(V, Ren),
+    case env__lookup(V1, Env) of
+	{ok, #function{free = Vs1}} ->
+	    closure_vars(Vs, Vs1 ++ As, Env, Ren);
+	_ ->
+	    closure_vars(Vs, As, Env, Ren)
+    end;
+closure_vars([V | Vs], As, Env, Ren) ->
+    closure_vars(Vs, [V | As], Env, Ren);
+closure_vars([], As, _Env, _Ren) ->
+    ordsets:from_list(As).
+
+%% We use the no-shadowing strategy, renaming variables on the fly and
+%% only when necessary to uphold the invariant.
+
+bind_vars(Vs, Env, Ren) -> 
+    bind_vars(Vs, [], Env, Ren).
+
+bind_vars([V | Vs], Vs1, Env, Ren) ->
+    Name = cerl:var_name(V),
+    {Name1, Ren1} = rename_var(Name, Env, Ren),
+    bind_vars(Vs, [cerl:update_c_var(V, Name1) | Vs1],
+	      env__bind(Name1, variable, Env), Ren1);
+bind_vars([], Vs, Env, Ren) ->
+    {lists:reverse(Vs), Env, Ren}.
+
+rename_var(Name, Env, Ren) ->
+    case env__is_defined(Name, Env) of
+	false ->
+	    {Name, Ren};
+	true ->
+	    New = env__new_name(Env),
+	    {New, ren__add(Name, New, Ren)}
+    end.
+
+%% This handles variable references *except* in function application
+%% operator positions (see apply_expr/4).
+%%
+%% The Beam compiler annotates function-variable references with 'id'
+%% info, eventually transforming a direct reference such as "fun f/2"
+%% into a new fun-expression "fun (X1,X2) -> apply f/2(X1,X2)" for which
+%% the info is used to create the lifted function as for any other fun.
+%% We do the same thing for function-bound variables.
+
+var(V, Env, Ren, S) ->
+    Name = ren__map(cerl:var_name(V), Ren),
+    case lookup_var(Name, Env) of
+	#function{name = F, free = Vs} ->
+	    {_, Arity} = F,
+	    Vs1 = make_vars(Arity),
+	    C = cerl:c_apply(cerl:c_var(F), Vs1),
+	    E = cerl:ann_c_fun(cerl:get_ann(V), Vs1, C),
+	    fun_expr_1(E, Vs, Env, Ren, S);
+	variable ->
+	    {cerl:update_c_var(V, Name), S}
+    end.
+
+lookup_var(V, Env) ->
+    case env__lookup(V, Env) of
+	{ok, X} ->
+	    X;
+	error ->
+	    error_msg("unbound variable `~P'.", [V, 5]),
+	    exit(error)
+    end.
+
+make_vars(N) when N > 0 ->
+    [cerl:c_var(list_to_atom("X" ++ integer_to_list(N)))
+     | make_vars(N - 1)];
+make_vars(0) ->
+    [].
+
+%% All funs that are not bound by module or letrec definitions will be
+%% rewritten to create explicit closures using "make fun". We don't
+%% currently track ordinary let-bindings of funs, as in "let F = fun
+%% ... in ...apply F(...)...".
+%%
+%% Note that we (currently) follow the Beam naming convention, including
+%% the free variables in the arity of the name, even though the actual
+%% function typically expects a different number of parameters.
+
+fun_expr(F, Env, Ren, S) ->
+    Free = closure_vars(cerl_trees:free_variables(F), Env, Ren),
+    Vs = [cerl:c_var(V) || V <- Free],
+    fun_expr_1(F, Vs, Env, Ren, S).
+    
+fun_expr_1(F, Vs, Env, Ren, S) ->
+    Arity = cerl:fun_arity(F) + length(Vs),    % for the name only
+    {Info, S1} = fun_info(F, Env, S),
+    Name = {Info#fun_info.name, Arity},
+    S2 = lift_fun(Name, F, Vs, Env, Ren, S1),
+    {make_fun_primop(Name, Vs, Info, F, S2), S2}.
+
+make_fun_primop({Name, Arity}, Free, #fun_info{id = Id, hash = Hash},
+		F, S) ->
+    Module = s__get_module_name(S),
+    cerl:update_c_primop(F, cerl:c_atom(?PRIMOP_MAKE_FUN),
+			 [cerl:c_atom(Module),
+			  cerl:c_atom(Name),
+			  cerl:c_int(Arity),
+			  cerl:c_int(Hash),
+			  cerl:c_int(Id),
+			  cerl:make_list(Free)]).
+
+%% Getting attached fun-info, if present; otherwise making it up.
+
+fun_info(E, Env, S) ->
+    case lists:keyfind(id, 1, cerl:get_ann(E)) of
+	{id, {Id, H, Name}} ->
+	    %% io:fwrite("Got fun-info: ~w: {~w,~w}.\n", [Name,Id,H]),
+	    {#fun_info{name = Name, id = Id, hash = H}, S};
+	_ ->
+	    io:fwrite("Warning - fun not annotated: "
+		      "making up new name.\n"), % for now
+ 	    {{Name,_Arity}, S1} = new_fun_name(E, Env, S),
+ 	    {#fun_info{name = Name, id = 0, hash = 0}, S1}
+    end.
+
+fun_name_base(FName, FArity) ->
+    "-" ++ atom_to_list(FName) ++ "/" ++ integer_to_list(FArity).
+
+%% Generate a name for the new function, using a the same convention
+%% that is used by the Beam compiler.
+new_fun_name(F, Env, S) ->
+    {FName, FArity} = s__get_function(S),
+    Base = fun_name_base(FName, FArity) ++ "-fun-",
+    Arity = cerl:fun_arity(F),
+    new_fun_name(Base, Arity, Env, S).
+
+%% Creating a new function name that is not in the environment and is
+%% not already used for some other lifted function.
+
+new_fun_name(Base, Arity, Env, S) ->
+    F = fun (N) ->
+		{list_to_atom(Base ++ integer_to_list(N)), Arity}
+	end,
+    new_fun_name(Base, Arity, Env, S, F).
+
+new_fun_name(Base, Arity, Env, S, F) ->
+    %% Note that repeated calls to env__new_function_name/2 will yield
+    %% different names even though Env and F are the same.
+    Name = env__new_function_name(F, Env),
+    case s__is_function_name(Name, S) of
+	true ->
+	    new_fun_name(Base, Arity, Env, S, F);
+	false ->
+	    {Name, S}
+    end.
+
+%% This lifts the fun to a new top-level function which uses the calling
+%% convention for closures, with the closure itself as the final
+%% parameter. Note that the free variables (if any) are already in the
+%% environment.
+%%
+%% It should not be possible for the original parameters to clash with
+%% the free ones (in that case they cannot be free), but we do the full
+%% bind-and-rename anyway, since it's easiest.
+
+lift_fun(Name, F, Free, Env, Ren, S) ->
+    %% If the name is already in the list of top-level definitions, we
+    %% assume we have already generated this function, and do not need
+    %% to do it again (typically, this happens for 'fun f/n'-variables
+    %% that have been duplicated before being rewritten to actual
+    %% fun-expressions, and the name is taken from their annotations).
+    %% Otherwise, we add the name to the list.
+    case s__is_function_name(Name, S) of
+	true ->
+	    S;
+	false ->
+	    S1 = s__add_function_name(Name, S),
+	    lift_fun_1(Name, F, Free, Env, Ren, S1)
+    end.
+
+lift_fun_1(Name, F, Free, Env, Ren, S) ->
+    %% (The original parameters must be added to the environment before
+    %% we generate the new variable for the closure parameter.)
+    {Vs, Env1, Ren1} = bind_vars(cerl:fun_vars(F), Env, Ren),
+    V = env__new_name(Env1),
+    Env2 = env__bind(V, variable, Env1),
+    {B, S1} = expr(cerl:fun_body(F), Env2, Ren1, S),
+    %% We unpack all free variables from the closure upon entering.
+    %% (Adding this to the body before we process it would introduce
+    %% unnecessary, although harmless, renaming of the free variables.)
+    Es = closure_elements(length(Free), cerl:c_var(V)),
+    B1 = cerl:c_let(Free, cerl:c_values(Es), B),
+    %% The closure itself is passed as the last argument. The new
+    %% function is annotated as being a closure-call entry point.
+    E = cerl:ann_c_fun([closure, {closure_orig_arity, cerl:fun_arity(F)}], Vs ++ [cerl:c_var(V)], B1),
+    s__add_def(cerl:c_var(Name), E, S1).
+
+closure_elements(N, V) ->
+    closure_elements(N, N + 1, V).
+
+closure_elements(0, _, _) -> [];
+closure_elements(N, M, V) ->
+    [cerl:c_primop(cerl:c_atom(?PRIMOP_FUN_ELEMENT),
+		   [cerl:c_int(M - N), V])
+     | closure_elements(N - 1, M, V)].
+
+
+%% Function applications must be rewritten depending on the
+%% operator. For a call to a known top-level function or letrec-bound
+%% function, we make a direct call, passing the free variables as extra
+%% parameters (we know they are in scope, since variables may not be
+%% shadowed). Otherwise, we create an "apply fun" primop call that
+%% expects a closure.
+
+apply_expr(E, Env, Ren, S) ->
+    {As, S1} = expr_list(cerl:apply_args(E), Env, Ren, S),
+    Op = cerl:apply_op(E),
+    case cerl:is_c_var(Op) of
+	true ->
+	    Name = ren__map(cerl:var_name(Op), Ren),
+	    case lookup_var(Name, Env) of
+		#function{name = F, free = Vs} ->
+		    Vs1 = As ++ [cerl:c_var(V) || V <- Vs],
+		    {cerl:update_c_apply(E, cerl:c_var(F), Vs1), S1};
+		variable ->
+		    apply_expr_1(E, Op, As, Env, Ren, S1)
+	    end;
+	_ ->
+	    apply_expr_1(E, Op, As, Env, Ren, S1)
+    end.
+
+%% Note that this primop call only communicates the necessary
+%% information to the core-to-icode stage, which rewrites it to use the
+%% real calling convention for funs.
+
+apply_expr_1(E, Op, As, Env, Ren, S) ->
+    {Op1, S1} = expr(Op, Env, Ren, S),
+    Call = cerl:update_c_primop(E, cerl:c_atom(?PRIMOP_APPLY_FUN),
+				[Op1, cerl:make_list(As)]),
+    {Call, S1}.
+
+
+%% ---------------------------------------------------------------------
+%% Environment
+
+env__new() ->
+    rec_env:empty().
+
+env__bind(Key, Value, Env) ->
+    rec_env:bind(Key, Value, 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__new_name(Env) ->
+    rec_env:new_key(Env).
+
+env__new_function_name(F, Env) ->
+    rec_env:new_key(F, Env).
+
+
+%% ---------------------------------------------------------------------
+%% Renaming
+
+ren__new() ->
+    dict:new().
+
+ren__add(Key, Value, Ren) ->
+    dict:store(Key, Value, Ren).
+
+ren__map(Key, Ren) ->  
+    case dict:find(Key, Ren) of
+	{ok, Value} ->
+	    Value;
+	error ->
+	    Key
+    end.
+
+
+%% ---------------------------------------------------------------------
+%% State
+
+-record(state, {module :: module(), function :: {atom(), arity()},
+		names, refs, defs = []}).
+
+s__new(Module) ->
+    #state{module = Module, names = sets:new(), refs = dict:new()}.
+
+s__add_function_name(Name, S) ->
+    S#state{names = sets:add_element(Name, S#state.names)}.
+
+s__is_function_name(Name, S) ->
+    sets:is_element(Name, S#state.names).
+
+s__get_module_name(S) ->
+    S#state.module.
+
+s__enter_function(F, S) ->
+    S#state{function = F}.
+
+s__get_function(S) ->
+    S#state.function.
+
+s__add_def(V, F, S) ->
+    S#state{defs = [{V, F} | S#state.defs]}.
+
+s__get_defs(S) ->
+    S#state.defs.
+
+
+%% ---------------------------------------------------------------------
+%% Reporting
+
+%% internal_error_msg(S) ->
+%%     internal_error_msg(S, []).
+
+%% internal_error_msg(S, Vs) ->
+%%     error_msg(lists:concat(["Internal error: ", S]), Vs).
+
+%% error_msg(S) ->
+%%     error_msg(S, []).
+
+error_msg(S, Vs) ->
+    error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+%% warning_msg(S) ->
+%%     warning_msg(S, []).
+
+%% warning_msg(S, Vs) ->
+%%     info_msg(lists:concat(["warning: ", S]), Vs).
+
+%% info_msg(S) ->
+%%     info_msg(S, []).
+
+%% info_msg(S, Vs) ->
+%%     error_logger:info_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
diff --git a/lib/hipe/cerl/cerl_closurean.erl b/lib/hipe/cerl/cerl_closurean.erl
new file mode 100644
index 0000000000..12771668ac
--- /dev/null
+++ b/lib/hipe/cerl/cerl_closurean.erl
@@ -0,0 +1,862 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% =====================================================================
+%% Closure analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2001-2002 Richard Carlsson
+%%
+%% Author contact: [email protected]
+%% =====================================================================
+
+%% 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(), escapes(), 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(), escapes(), 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(F, A) when is_atom(F), is_integer(A) -> true.
+
+-spec is_escape_op(module(), 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(match_fail, 1) -> true;
+is_literal_op(F, A) when is_atom(F), is_integer(A) -> false.
+
+-spec is_literal_op(module(), 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/hipe/cerl/cerl_hipe_primops.hrl b/lib/hipe/cerl/cerl_hipe_primops.hrl
new file mode 100644
index 0000000000..36b1b62901
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hipe_primops.hrl
@@ -0,0 +1,88 @@
+%% ========================-*-erlang-*-=================================
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% Predefined Core Erlang primitive operations used by HiPE
+%%
+%% Copyright (C) 2000 Richard Carlsson
+%%
+%% Author contact: [email protected]
+%% =====================================================================
+
+%% These definitions give the names of Core Erlang primops recognized by
+%% HiPE. Many of them (e.g., 'not'/'and'/'or', and the type tests), are
+%% not primops on the Icode level, but are inline-expanded by the
+%% translation from Core Erlang to Icode, or are renamed/rewritten to a
+%% corresponding ICode primop; they only exist to help the translation.
+
+%%-define(PRIMOP_IDENTITY, identity).		% arity 1
+-define(PRIMOP_NOT, 'not').			% arity 1
+-define(PRIMOP_AND, 'and').			% arity 2
+-define(PRIMOP_OR, 'or').			% arity 2
+-define(PRIMOP_XOR, 'xor').			% arity 2
+-define(PRIMOP_ADD, '+').			% arity 2
+-define(PRIMOP_SUB, '-').			% arity 2
+-define(PRIMOP_NEG, neg).			% arity 1
+-define(PRIMOP_MUL, '*').			% arity 2
+-define(PRIMOP_DIV, '/').			% arity 2
+-define(PRIMOP_INTDIV, 'div').			% arity 2
+-define(PRIMOP_REM, 'rem').			% arity 2
+-define(PRIMOP_BAND, 'band').			% arity 2
+-define(PRIMOP_BOR, 'bor').			% arity 2
+-define(PRIMOP_BXOR, 'bxor').			% arity 2
+-define(PRIMOP_BNOT, 'bnot').			% arity 1
+-define(PRIMOP_BSL, 'bsl').			% arity 2
+-define(PRIMOP_BSR, 'bsr').			% arity 2
+-define(PRIMOP_EQ, '==').			% arity 2
+-define(PRIMOP_NE, '/=').			% arity 2
+-define(PRIMOP_EXACT_EQ, '=:=').		% arity 2
+-define(PRIMOP_EXACT_NE, '=/=').		% arity 2
+-define(PRIMOP_LT, '<').			% arity 2
+-define(PRIMOP_GT, '>').			% arity 2
+-define(PRIMOP_LE, '=<').			% arity 2
+-define(PRIMOP_GE, '>=').			% arity 2
+-define(PRIMOP_IS_ATOM, 'is_atom').		% arity 1
+-define(PRIMOP_IS_BIGNUM, 'is_bignum').		% arity 1
+-define(PRIMOP_IS_BINARY, 'is_binary').		% arity 1
+-define(PRIMOP_IS_CONSTANT, 'is_constant').	% arity 1
+-define(PRIMOP_IS_FIXNUM, 'is_fixnum').		% arity 1
+-define(PRIMOP_IS_FLOAT, 'is_float').		% arity 1
+-define(PRIMOP_IS_FUNCTION, 'is_function').	% arity 1
+-define(PRIMOP_IS_INTEGER, 'is_integer').	% arity 1
+-define(PRIMOP_IS_LIST, 'is_list').		% arity 1
+-define(PRIMOP_IS_NUMBER, 'is_number').		% arity 1
+-define(PRIMOP_IS_PID, 'is_pid').		% arity 1
+-define(PRIMOP_IS_PORT, 'is_port').		% arity 1
+-define(PRIMOP_IS_REFERENCE, 'is_reference').	% arity 1
+-define(PRIMOP_IS_TUPLE, 'is_tuple').		% arity 1
+-define(PRIMOP_IS_RECORD, 'is_record').		% arity 3
+-define(PRIMOP_EXIT, exit).			% arity 1
+-define(PRIMOP_THROW, throw).			% arity 1
+-define(PRIMOP_ERROR, error).			% arity 1,2
+-define(PRIMOP_RETHROW, raise).			% arity 2
+-define(PRIMOP_RECEIVE_SELECT, receive_select).	% arity 0
+-define(PRIMOP_RECEIVE_NEXT, receive_next).	% arity 0
+-define(PRIMOP_ELEMENT, element).		% arity 2
+-define(PRIMOP_DSETELEMENT, dsetelement).	% arity 3
+-define(PRIMOP_MAKE_FUN, make_fun).		% arity 6
+-define(PRIMOP_APPLY_FUN, apply_fun).		% arity 2
+-define(PRIMOP_FUN_ELEMENT, closure_element).	% arity 2
+-define(PRIMOP_SET_LABEL, set_label).           % arity 1
+-define(PRIMOP_GOTO_LABEL, goto_label).         % arity 1
+-define(PRIMOP_REDUCTION_TEST, reduction_test). % arity 0
+-define(PRIMOP_BS_CONTEXT_TO_BINARY, bs_context_to_binary). % arity 1
diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl
new file mode 100644
index 0000000000..8f6c3561c9
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hipeify.erl
@@ -0,0 +1,655 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2000-2004 Richard Carlsson
+%% @doc HiPE-ification of Core Erlang code. Prepares Core Erlang code
+%% for translation to ICode.
+%% @see cerl_to_icode
+
+-module(cerl_hipeify).
+
+-define(NO_UNUSED, true).
+
+-export([transform/2]).
+-ifndef(NO_UNUSED).
+-export([core_transform/2]).
+-endif.
+
+-include("cerl_hipe_primops.hrl").
+
+-record(ctxt, {class = expr}).
+
+
+%% @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_hipeify}</code> to insert this function as a compilation
+%% pass.</p>
+%%
+%% @see transform/2
+
+-ifndef(NO_UNUSED).
+core_transform(M, Opts) ->
+    cerl:to_records(transform(cerl:from_records(M), Opts)).
+-endif.	% NO_UNUSED
+%% @clear
+
+
+%% @spec transform(Module::cerl(), Options::[term()]) -> cerl()
+%%
+%%    cerl() = cerl:cerl()
+%%
+%% @doc Rewrites a Core Erlang module to a form suitable for further
+%% translation to HiPE Icode. See module <code>cerl_to_icode</code> for
+%% details.
+%%
+%% @see cerl_to_icode
+%% @see cerl_cconv
+
+-spec transform(cerl:c_module(), [term()]) -> cerl:c_module().
+
+transform(E, Opts) ->
+    %% Start by closure converting the code
+    module(cerl_cconv:transform(E, Opts), Opts).
+
+module(E, Opts) ->
+    {Ds, Env, Ren} = add_defs(cerl:module_defs(E), env__new(),
+			      ren__new()),
+    M = cerl:module_name(E),
+    S0 = s__new(cerl:atom_val(M)),    	    
+    S = s__set_pmatch(proplists:get_value(pmatch, Opts, true), S0),
+    {Ds1, _} = defs(Ds, true, Env, Ren, S),
+    cerl:update_c_module(E, M, cerl:module_exports(E),
+			 cerl:module_attrs(E), Ds1).
+
+%% Note that the environment is defined on the renamed variables.
+
+expr(E0, Env, Ren, Ctxt, S0) ->
+    %% Do peephole optimizations as we traverse the code.
+    E = cerl_lib:reduce_expr(E0),
+    case cerl:type(E) of
+ 	literal ->
+	    {E, S0};
+	var ->
+	    variable(E, Env, Ren, Ctxt, S0);
+	values ->
+	    {Es, S1} = expr_list(cerl:values_es(E), Env, Ren, Ctxt, S0),
+ 	    {cerl:update_c_values(E, Es), S1};
+	cons ->
+	    {E1, S1} = expr(cerl:cons_hd(E), Env, Ren, Ctxt, S0),
+	    {E2, S2} = expr(cerl:cons_tl(E), Env, Ren, Ctxt, S1),
+	    {cerl:update_c_cons(E, E1, E2), S2};
+ 	tuple ->
+	    {Es, S1} = expr_list(cerl:tuple_es(E), Env, Ren, Ctxt, S0),
+	    {cerl:update_c_tuple(E, Es), S1};
+ 	'let' ->
+	    let_expr(E, Env, Ren, Ctxt, S0);
+	seq ->
+	    {A, S1} = expr(cerl:seq_arg(E), Env, Ren, Ctxt, S0),
+	    {B, S2} = expr(cerl:seq_body(E), Env, Ren, Ctxt, S1),
+ 	    {cerl:update_c_seq(E, A, B), S2};
+ 	apply ->
+	    {Op, S1} = expr(cerl:apply_op(E), Env, Ren, Ctxt, S0),
+	    {As, S2} = expr_list(cerl:apply_args(E), Env, Ren, Ctxt, S1),
+ 	    {cerl:update_c_apply(E, Op, As), S2};
+ 	call ->
+	    {M, S1} = expr(cerl:call_module(E), Env, Ren, Ctxt, S0),
+	    {N, S2} = expr(cerl:call_name(E), Env, Ren, Ctxt, S1),
+	    {As, S3} = expr_list(cerl:call_args(E), Env, Ren, Ctxt, S2),
+ 	    {rewrite_call(E, M, N, As, S3), S3};
+ 	primop ->
+	    {As, S1} = expr_list(cerl:primop_args(E), Env, Ren, Ctxt, S0),
+	    N = cerl:primop_name(E),
+	    {rewrite_primop(E, N, As, S1), S1};
+ 	'case' ->
+	    case_expr(E, Env, Ren, Ctxt, S0);
+ 	'fun' ->
+	    Vs = cerl:fun_vars(E),
+	    {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+	    {B, S1} = expr(cerl:fun_body(E), Env1, Ren1, Ctxt, S0),
+	    {cerl:update_c_fun(E, Vs1, B), S1};
+ 	'receive' ->
+	    receive_expr(E, Env, Ren, Ctxt, S0);
+ 	'try' ->
+	    {A, S1} = expr(cerl:try_arg(E), Env, Ren, Ctxt, S0),
+	    Vs = cerl:try_vars(E),
+	    {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+	    {B, S2} = expr(cerl:try_body(E), Env1, Ren1, Ctxt, S1),
+	    Evs = cerl:try_evars(E),
+	    {Evs1, Env2, Ren2} = add_vars(Evs, Env, Ren),
+	    {H, S3} = expr(cerl:try_handler(E), Env2, Ren2, Ctxt, S2),
+	    {cerl:update_c_try(E, A, Vs1, B, Evs1, H), S3};
+ 	'catch' ->
+	    catch_expr(E, Env, Ren, Ctxt, S0);
+	letrec ->
+	    {Ds, Env1, Ren1} = add_defs(cerl:letrec_defs(E), Env, Ren),
+	    {Ds1, S1} = defs(Ds, false, Env1, Ren1, S0),
+	    {B, S2} = expr(cerl:letrec_body(E), Env1, Ren1, Ctxt, S1),
+	    {cerl:update_c_letrec(E, Ds1, B), S2};
+	binary ->
+	    {Segs, S1} = expr_list(cerl:binary_segments(E), Env, Ren,
+				   Ctxt, S0),
+	    {cerl:update_c_binary(E, Segs), S1};
+	bitstr ->
+	    {E1,S1} = expr(cerl:bitstr_val(E), Env, Ren, Ctxt, S0),
+	    {E2,S2} = expr(cerl:bitstr_size(E), Env, Ren, Ctxt, S1),	
+	    E3 = cerl:bitstr_unit(E), 
+	    E4 = cerl:bitstr_type(E),
+	    E5 = cerl:bitstr_flags(E),
+	    {cerl:update_c_bitstr(E, E1, E2, E3, E4, E5), S2} 
+    end.
+
+guard_expr(E, Env, Ren, Ctxt, S) ->
+    expr(E, Env, Ren, Ctxt#ctxt{class = guard}, S).
+
+expr_list(Es, Env, Ren, Ctxt, S0) ->
+    list(Es, Env, Ren, Ctxt, S0, fun expr/5).
+
+list([E | Es], Env, Ren, Ctxt, S0, F) ->
+    {E1, S1} = F(E, Env, Ren, Ctxt, S0),
+    {Es1, S2} = list(Es, Env, Ren, Ctxt, S1, F),
+    {[E1 | Es1], S2};
+list([], _, _, _, S, _) ->
+    {[], S}.
+
+pattern(E, Env, Ren) ->
+    case cerl:type(E) of
+ 	literal ->
+	    E;
+	var ->
+	    cerl:update_c_var(E, ren__map(cerl:var_name(E), Ren));
+	values ->
+	    Es = pattern_list(cerl:values_es(E), Env, Ren),
+ 	    cerl:update_c_values(E, Es);
+	cons ->
+	    E1 = pattern(cerl:cons_hd(E), Env, Ren),
+	    E2 = pattern(cerl:cons_tl(E), Env, Ren),
+	    cerl:update_c_cons(E, E1, E2);
+ 	tuple ->
+	    Es = pattern_list(cerl:tuple_es(E), Env, Ren),
+	    cerl:update_c_tuple(E, Es);
+	alias ->
+	    V = pattern(cerl:alias_var(E), Env, Ren),
+	    P = pattern(cerl:alias_pat(E), Env, Ren),
+	    cerl:update_c_alias(E, V, P);
+	binary ->
+	    Segs = pattern_list(cerl:binary_segments(E), Env, Ren),
+	    cerl:update_c_binary(E, Segs);
+	bitstr ->
+	    E1 = pattern(cerl:bitstr_val(E), Env, Ren),
+	    E2 = pattern(cerl:bitstr_size(E), Env, Ren),	
+	    E3 = cerl:bitstr_unit(E), 
+	    E4 = cerl:bitstr_type(E),
+	    E5 = cerl:bitstr_flags(E),
+	    cerl:update_c_bitstr(E, E1, E2, E3, E4, E5)
+    end.
+
+pattern_list(ExprList, Env, Ren) ->
+    [pattern(E, Env, Ren) || E <- ExprList].
+
+%% Visit the function body of each definition. We insert an explicit
+%% reduction test at the start of each function.
+
+defs(Ds, Top, Env, Ren, S) ->
+    defs(Ds, [], Top, Env, Ren, S).
+
+defs([{V, F} | Ds], Ds1, Top, Env, Ren, S0) ->
+    S1 = case Top of
+	     true -> s__enter_function(cerl:var_name(V), S0);
+	     false -> S0
+	 end,
+    {B, S2} = expr(cerl:fun_body(F), Env, Ren, #ctxt{}, S1),
+    B1 = cerl:c_seq(cerl:c_primop(cerl:c_atom(?PRIMOP_REDUCTION_TEST), []),
+		    B),
+    F1 = cerl:update_c_fun(F, cerl:fun_vars(F), B1),
+    defs(Ds, [{V, F1} | Ds1], Top, Env, Ren, S2);
+defs([], Ds, _Top, _Env, _Ren, S) ->
+    {lists:reverse(Ds), S}.
+
+case_expr(E, Env, Ren, Ctxt, S0) ->
+    {A, S1} = expr(cerl:case_arg(E), Env, Ren, Ctxt, S0),
+    {Cs, S2} = clause_list(cerl:case_clauses(E), Env, Ren, Ctxt, S1),
+    case s__get_revisit(S2) of
+	false ->
+	    {E1, Vs, S3} = pmatch(Cs, Env, Ren, Ctxt, S2),
+	    {cerl:c_let(Vs, A, E1), S3};
+	true ->
+	    {cerl:c_case(A, Cs), S2}
+    end.
+
+%% Note: There is an ordering problem with switch-clauses and pattern
+%% matching compilation. We must process any receive-clauses first,
+%% making the message queue operations explicit, before we can do
+%% pattern matching compilation. However, the latter can introduce new
+%% expressions - in particular new guards - which also need processing.
+%% Hence, we must process the clauses, then do pattern matching
+%% compilation, and then re-visit the resulting expression with pattern
+%% matching compilation disabled.
+
+pmatch(Cs, Env, _Ren, Ctxt, S0) ->
+    {E, Vs} = case s__get_pmatch(S0) of
+		  true ->
+		      cerl_pmatch:clauses(Cs, Env);
+		  no_duplicates ->
+		      put('cerl_pmatch_duplicate_code', never),
+		      cerl_pmatch:clauses(Cs, Env);
+		  duplicate_all ->
+		      put('cerl_pmatch_duplicate_code', always),
+		      cerl_pmatch:clauses(Cs, Env);
+		  false ->
+		      Vs0 = new_vars(cerl:clause_arity(hd(Cs)), Env),
+		      {cerl:c_case(cerl:c_values(Vs0), Cs), Vs0}
+	      end,
+    %% Revisit the resulting expression. Pass an empty renaming, since
+    %% all variables in E have already been properly renamed and must
+    %% not be renamed again by accident.
+    {E1, S1} = expr(E, Env, ren__new(), Ctxt, s__set_revisit(true, S0)),
+    {E1, Vs, s__set_revisit(false, S1)}.
+
+clause_list(Cs, Env, Ren, Ctxt, S) ->
+    list(Cs, Env, Ren, Ctxt, S, fun clause/5).
+
+clause(E, Env, Ren, Ctxt, S0) ->
+    Vs = cerl:clause_vars(E),
+    {_, Env1, Ren1} = add_vars(Vs, Env, Ren),
+    %% Visit patterns to rename variables.
+    Ps = pattern_list(cerl:clause_pats(E), Env1, Ren1),
+    {G, S1} = guard_expr(cerl:clause_guard(E), Env1, Ren1, Ctxt, S0),
+    {B, S2} = expr(cerl:clause_body(E), Env1, Ren1, Ctxt, S1),
+    {cerl:update_c_clause(E, Ps, G, B), S2}.
+
+%% We use the no-shadowing strategy, renaming variables on the fly and
+%% only when necessary to uphold the invariant.
+
+add_vars(Vs, Env, Ren) ->
+    add_vars(Vs, [], Env, Ren).
+
+add_vars([V | Vs], Vs1, Env, Ren) ->
+    Name = cerl:var_name(V),
+    {Name1, Ren1} = rename(Name, Env, Ren),
+    add_vars(Vs, [cerl:update_c_var(V, Name1) | Vs1],
+	     env__bind(Name1, variable, Env), Ren1);
+add_vars([], Vs, Env, Ren) ->
+    {lists:reverse(Vs), Env, Ren}.
+
+rename(Name, Env, Ren) ->
+    case env__is_defined(Name, Env) of
+	false ->
+	    {Name, Ren};
+	true ->
+	    New = env__new_name(Env),
+	    {New, ren__add(Name, New, Ren)}
+    end.
+
+%% Setting up the environment for a list of letrec-bound definitions.
+
+add_defs(Ds, Env, Ren) ->
+    add_defs(Ds, [], Env, Ren).
+
+add_defs([{V, F} | Ds], Ds1, Env, Ren) ->
+    Name = cerl:var_name(V),
+    {Name1, Ren1} =
+	case env__is_defined(Name, Env) of
+	    false ->
+		{Name, Ren};
+	    true ->
+		{N, A} = Name,
+		S = atom_to_list(N) ++ "_",
+		F1 = fun (Num) ->
+			    {list_to_atom(S ++ integer_to_list(Num)), A}
+		    end,
+		New = env__new_function_name(F1, Env),
+		{New, ren__add(Name, New, Ren)}
+	end,
+    add_defs(Ds, [{cerl:update_c_var(V, Name1), F} | Ds1],
+	     env__bind(Name1, function, Env), Ren1);
+add_defs([], Ds, Env, Ren) ->
+    {lists:reverse(Ds), Env, Ren}.
+
+%% We change remote calls to important built-in functions into primop
+%% calls. In some cases (e.g., for the boolean operators), this is
+%% mainly to allow the cerl_to_icode module to handle them more
+%% straightforwardly. In most cases however, it is simply because they
+%% are supposed to be represented as primop calls on the Icode level.
+
+rewrite_call(E, M, F, As, S) ->
+    case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
+	true ->
+	    case call_to_primop(cerl:atom_val(M),
+				cerl:atom_val(F),
+				length(As))
+		of
+	        {yes, ?PRIMOP_IS_RECORD} ->
+		    %% Needs additional testing
+		    [_, Tag, Arity] = As,
+		    case (cerl:is_c_atom(Tag) andalso 
+			  cerl:is_c_int(Arity)) of
+		        true ->
+			    %% The primop might need further handling
+			    N1 = cerl:c_atom(?PRIMOP_IS_RECORD),
+			    E1 = cerl:update_c_primop(E, N1, As),
+			    rewrite_primop(E1, N1, As, S);
+		        false ->
+			    cerl:update_c_call(E, M, F, As)
+		    end;
+		{yes, N} ->
+		    %% The primop might need further handling
+		    N1 = cerl:c_atom(N),
+		    E1 = cerl:update_c_primop(E, N1, As),
+		    rewrite_primop(E1, N1, As, S);
+		no ->
+		    cerl:update_c_call(E, M, F, As)
+	    end;
+	false ->
+	    cerl:update_c_call(E, M, F, As)
+    end.
+
+call_to_primop(erlang, 'not', 1) -> {yes, ?PRIMOP_NOT};
+call_to_primop(erlang, 'and', 2) -> {yes, ?PRIMOP_AND};
+call_to_primop(erlang, 'or', 2) -> {yes, ?PRIMOP_OR};
+call_to_primop(erlang, 'xor', 2) -> {yes, ?PRIMOP_XOR};
+call_to_primop(erlang, '+', 2) -> {yes, ?PRIMOP_ADD};
+%%call_to_primop(erlang, '+', 1) -> {yes, ?PRIMOP_IDENTITY};
+call_to_primop(erlang, '-', 2) -> {yes, ?PRIMOP_SUB};
+call_to_primop(erlang, '-', 1) -> {yes, ?PRIMOP_NEG};
+call_to_primop(erlang, '*', 2) -> {yes, ?PRIMOP_MUL};
+call_to_primop(erlang, '/', 2) -> {yes, ?PRIMOP_DIV};
+call_to_primop(erlang, 'div', 2) -> {yes, ?PRIMOP_INTDIV};
+call_to_primop(erlang, 'rem', 2) -> {yes, ?PRIMOP_REM};
+call_to_primop(erlang, 'band', 2) -> {yes, ?PRIMOP_BAND};
+call_to_primop(erlang, 'bor', 2) -> {yes, ?PRIMOP_BOR};
+call_to_primop(erlang, 'bxor', 2) -> {yes, ?PRIMOP_BXOR};
+call_to_primop(erlang, 'bnot', 1) -> {yes, ?PRIMOP_BNOT};
+call_to_primop(erlang, 'bsl', 2) -> {yes, ?PRIMOP_BSL};
+call_to_primop(erlang, 'bsr', 2) -> {yes, ?PRIMOP_BSR};
+call_to_primop(erlang, '==', 2) -> {yes, ?PRIMOP_EQ};
+call_to_primop(erlang, '/=', 2) -> {yes, ?PRIMOP_NE};
+call_to_primop(erlang, '=:=', 2) -> {yes, ?PRIMOP_EXACT_EQ};
+call_to_primop(erlang, '=/=', 2) -> {yes, ?PRIMOP_EXACT_NE};
+call_to_primop(erlang, '<', 2) -> {yes, ?PRIMOP_LT};
+call_to_primop(erlang, '>', 2) -> {yes, ?PRIMOP_GT};
+call_to_primop(erlang, '=<', 2) -> {yes, ?PRIMOP_LE};
+call_to_primop(erlang, '>=', 2) -> {yes, ?PRIMOP_GE};
+call_to_primop(erlang, is_atom, 1) -> {yes, ?PRIMOP_IS_ATOM};
+call_to_primop(erlang, is_binary, 1) -> {yes, ?PRIMOP_IS_BINARY};
+call_to_primop(erlang, is_constant, 1) -> {yes, ?PRIMOP_IS_CONSTANT};
+call_to_primop(erlang, is_float, 1) -> {yes, ?PRIMOP_IS_FLOAT};
+call_to_primop(erlang, is_function, 1) -> {yes, ?PRIMOP_IS_FUNCTION};
+call_to_primop(erlang, is_integer, 1) -> {yes, ?PRIMOP_IS_INTEGER};
+call_to_primop(erlang, is_list, 1) -> {yes, ?PRIMOP_IS_LIST};
+call_to_primop(erlang, is_number, 1) -> {yes, ?PRIMOP_IS_NUMBER};
+call_to_primop(erlang, is_pid, 1) -> {yes, ?PRIMOP_IS_PID};
+call_to_primop(erlang, is_port, 1) -> {yes, ?PRIMOP_IS_PORT};
+call_to_primop(erlang, is_reference, 1) -> {yes, ?PRIMOP_IS_REFERENCE};
+call_to_primop(erlang, is_tuple, 1) -> {yes, ?PRIMOP_IS_TUPLE};
+call_to_primop(erlang, internal_is_record, 3) -> {yes, ?PRIMOP_IS_RECORD};
+call_to_primop(erlang, is_record, 3) -> {yes, ?PRIMOP_IS_RECORD};
+call_to_primop(erlang, element, 2) -> {yes, ?PRIMOP_ELEMENT};
+call_to_primop(erlang, exit, 1) -> {yes, ?PRIMOP_EXIT};
+call_to_primop(erlang, throw, 1) -> {yes, ?PRIMOP_THROW};
+call_to_primop(erlang, error, 1) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(erlang, error, 2) -> {yes, ?PRIMOP_ERROR};
+call_to_primop(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> no.
+
+%% Also, some primops (introduced by Erlang to Core Erlang translation
+%% and possibly other stages) must be recognized and rewritten.
+
+rewrite_primop(E, N, As, S) ->
+    case {cerl:atom_val(N), As} of
+	{match_fail, [R]} ->
+	    M = s__get_module_name(S),
+	    {F, A} = s__get_function_name(S),
+	    Stack = cerl:abstract([{M, F, A}]),
+	    case cerl:type(R) of
+		tuple ->
+		    %% Function clause failures have a special encoding
+		    %% as '{function_clause, Arg1, ..., ArgN}'.
+		    case cerl:tuple_es(R) of
+			[X | Xs] ->
+			    case cerl:is_c_atom(X) of
+				true ->
+				    case cerl:atom_val(X) of
+					function_clause ->
+					    FStack = cerl:make_list(
+						       [cerl:c_tuple(
+							  [cerl:c_atom(M),
+							   cerl:c_atom(F),
+							   cerl:make_list(Xs)])]),
+					    match_fail(E, X, FStack);
+					_ ->
+					    match_fail(E, R, Stack)
+				    end;
+				false ->
+				    match_fail(E, R, Stack)
+			    end;
+			_ ->
+			    match_fail(E, R, Stack)
+		    end;
+		_ ->
+		    match_fail(E, R, Stack)
+	    end;
+	_ ->
+	    cerl:update_c_primop(E, N, As)
+    end.
+
+match_fail(E, R, Stack) ->
+    cerl:update_c_primop(E, cerl:c_atom(?PRIMOP_ERROR), [R, Stack]).
+
+%% Simple let-definitions (of degree 1) in guard context are always
+%% inline expanded. This is allowable, since they cannot have side
+%% effects, and it makes it easy to generate good code for boolean
+%% expressions. It could cause repeated evaluations, but typically,
+%% local definitions within guards are used exactly once.
+
+let_expr(E, Env, Ren, Ctxt, S) ->
+    if Ctxt#ctxt.class =:= guard ->
+	    case cerl:let_vars(E) of
+		[V] ->
+		    {Name, Ren1} = rename(cerl:var_name(V), Env, Ren),
+		    Env1 = env__bind(Name, {expr, cerl:let_arg(E)}, Env),
+		    expr(cerl:let_body(E), Env1, Ren1, Ctxt, S);
+		_ ->
+		    let_expr_1(E, Env, Ren, Ctxt, S)
+	    end;
+       true ->
+	    let_expr_1(E, Env, Ren, Ctxt, S)
+    end.
+
+let_expr_1(E, Env, Ren, Ctxt, S0) ->
+    {A, S1} = expr(cerl:let_arg(E), Env, Ren, Ctxt, S0),
+    Vs = cerl:let_vars(E),
+    {Vs1, Env1, Ren1} = add_vars(Vs, Env, Ren),
+    {B, S2} = expr(cerl:let_body(E), Env1, Ren1, Ctxt, S1),
+    {cerl:update_c_let(E, Vs1, A, B), S2}.
+
+variable(E, Env, Ren, Ctxt, S) ->
+    V = ren__map(cerl:var_name(E), Ren),
+    if Ctxt#ctxt.class =:= guard ->
+	    case env__lookup(V, Env) of
+		{ok, {expr, E1}} ->
+		    expr(E1, Env, Ren, Ctxt, S);   % inline
+		_ ->
+		    %% Since we don't track all bindings when we revisit
+		    %% guards, some names will not be in the environment.
+		    variable_1(E, V, S)
+	    end;
+       true ->
+	    variable_1(E, V, S)
+    end.
+
+variable_1(E, V, S) ->
+    {cerl:update_c_var(E, V), S}.
+
+%% A catch-expression 'catch Expr' is rewritten as:
+%%
+%%	try Expr
+%%	of (V) -> V
+%%	catch (T, V, E) ->
+%%	    letrec 'wrap'/1 = fun (V) -> {'EXIT', V}
+%%	    in case T of
+%%	         'throw' when 'true' -> V
+%%	         'exit' when 'true' -> 'wrap'/1(V)
+%%	         V when 'true' ->
+%%	             'wrap'/1({V, erlang:get_stacktrace()})
+%%	       end
+
+catch_expr(E, Env, Ren, Ctxt, S) ->
+    T = cerl:c_var('T'),
+    V = cerl:c_var('V'),
+    X = cerl:c_var('X'),
+    W = cerl:c_var({wrap,1}),
+    G = cerl:c_call(cerl:c_atom('erlang'),cerl:c_atom('get_stacktrace'),[]),
+    Cs = [cerl:c_clause([cerl:c_atom('throw')], V),
+	  cerl:c_clause([cerl:c_atom('exit')], cerl:c_apply(W, [V])),
+	  cerl:c_clause([T], cerl:c_apply(W, [cerl:c_tuple([V,G])]))
+	 ],
+    C = cerl:c_case(T, Cs),
+    F = cerl:c_fun([V], cerl:c_tuple([cerl:c_atom('EXIT'), V])),
+    H = cerl:c_letrec([{W,F}], C),
+    As = cerl:get_ann(E),
+    {B, S1} = expr(cerl:catch_body(E),Env, Ren, Ctxt, S),
+    {cerl:ann_c_try(As, B, [V], V, [T,V,X], H), S1}.
+
+%% Receive-expressions are rewritten as follows:
+%%
+%%	receive
+%%	    P1 when G1 -> B1
+%%	      ...
+%%	    Pn when Gn -> Bn
+%%	after T -> A end
+%% becomes:
+%%	receive
+%%	    M when 'true' ->
+%%	      case M of
+%%	        P1 when G1 -> do primop RECEIVE_SELECT B1
+%%	          ...
+%%	        Pn when Gn -> do primop RECEIVE_SELECT Bn
+%%	        Pn+1 when 'true' -> primop RECEIVE_NEXT()
+%%	    end
+%%	after T -> A end
+
+receive_expr(E, Env, Ren, Ctxt, S0) ->
+    case s__get_revisit(S0) of
+	false ->
+	    Cs = receive_clauses(cerl:receive_clauses(E)),
+	    {Cs1, S1} = clause_list(Cs, Env, Ren, Ctxt, S0),
+	    {B, Vs, S2} = pmatch(Cs1, Env, Ren, Ctxt, S1),
+	    {T, S3} = expr(cerl:receive_timeout(E), Env, Ren, Ctxt, S2),
+	    {A, S4} = expr(cerl:receive_action(E), Env, Ren, Ctxt, S3),
+	    {cerl:update_c_receive(E, [cerl:c_clause(Vs, B)], T, A), S4};
+	true ->
+	    %% we should never enter a receive-expression twice
+	    {E, S0}
+    end.
+
+receive_clauses([C | Cs]) ->
+    Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_SELECT), []),
+    B = cerl:c_seq(Call, cerl:clause_body(C)),
+    C1 =  cerl:update_c_clause(C, cerl:clause_pats(C),
+			       cerl:clause_guard(C), B),
+    [C1 | receive_clauses(Cs)];
+receive_clauses([]) ->
+    Call = cerl:c_primop(cerl:c_atom(?PRIMOP_RECEIVE_NEXT), []),
+    V = cerl:c_var('X'),    % any name is ok
+    [cerl:c_clause([V], Call)].
+
+new_vars(N, Env) ->
+    [cerl:c_var(V) || V <- env__new_names(N, Env)].
+
+%% ---------------------------------------------------------------------
+%% Environment
+
+env__new() ->
+    rec_env:empty().
+
+env__bind(Key, Value, Env) ->
+    rec_env:bind(Key, Value, Env).
+
+%% env__get(Key, Env) ->
+%%     rec_env:get(Key, Env).
+
+env__lookup(Key, Env) ->
+    rec_env:lookup(Key, Env).
+
+env__is_defined(Key, Env) ->
+    rec_env:is_defined(Key, Env).
+
+env__new_name(Env) ->
+    rec_env:new_key(Env).
+
+env__new_names(N, Env) ->
+    rec_env:new_keys(N, Env).
+
+env__new_function_name(F, Env) ->
+    rec_env:new_key(F, Env).
+
+%% ---------------------------------------------------------------------
+%% Renaming
+
+ren__new() ->
+    dict:new().
+
+ren__add(Key, Value, Ren) ->
+    dict:store(Key, Value, Ren).
+
+ren__map(Key, Ren) ->
+    case dict:find(Key, Ren) of
+	{ok, Value} ->
+	    Value;
+	error ->
+	    Key
+    end.
+
+%% ---------------------------------------------------------------------
+%% State
+
+%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all'
+
+-record(state, {module::atom(),
+		function::{atom(), 0..256},
+		pmatch=true,
+		revisit = false}).
+
+s__new(Module) ->
+    #state{module = Module}.
+
+s__get_module_name(S) ->
+    S#state.module.
+
+s__enter_function(F, S) ->
+    S#state{function = F}.
+
+s__get_function_name(S) ->
+    S#state.function.
+
+s__set_pmatch(V, S) ->
+    S#state{pmatch = V}.
+
+s__get_pmatch(S) ->
+    S#state.pmatch.
+
+s__set_revisit(V, S) ->
+    S#state{revisit = V}.
+
+s__get_revisit(S) ->
+    S#state.revisit.
diff --git a/lib/hipe/cerl/cerl_hybrid_transform.erl b/lib/hipe/cerl/cerl_hybrid_transform.erl
new file mode 100644
index 0000000000..b248b0ccd0
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hybrid_transform.erl
@@ -0,0 +1,153 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(cerl_hybrid_transform).
+
+%% Use compile option `{core_transform, cerl_hybrid_transform}' to
+%% insert this as a compilation pass.
+
+-export([transform/2, core_transform/2]).
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(Code, Opts) ->
+    cerl:to_records(transform(cerl:from_records(Code), Opts)).
+
+-spec transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+transform(Code, _Opts) ->
+    Code0 = cerl_trees:map(fun unfold_literal/1, Code),
+    {Code1, _} = cerl_trees:label(Code0),
+    io:fwrite("Running hybrid heap analysis..."),
+    {T1,_} = statistics(runtime),
+    {Code2, _, Vars} = cerl_messagean:annotate(Code1),
+    {T2,_} = statistics(runtime),
+    io:fwrite("(~w ms), transform...", [T2 - T1]),
+    Code3 = rewrite(Code2, Vars),
+    io:fwrite("done.\n"),
+    cerl_trees:map(fun fold_literal/1, Code3).
+
+unfold_literal(T) ->
+    cerl:unfold_literal(T).
+
+fold_literal(T) ->
+    cerl:fold_literal(T).
+
+%% If escape-annotated:
+%% {...} => hybrid:tuple([...])
+%% [H | T] => hybrid:cons(H, T)
+%%
+%% Wrapper for args to hybrid:cons/hybrid:tuple that may need copying:
+%% hybrid:copy(A)
+
+rewrite(Node, Vars) ->
+    case cerl:type(Node) of
+	tuple ->
+	    Es = rewrite_list(cerl:tuple_es(Node), Vars),
+	    case is_escaping(Node) of
+		false ->
+		    cerl:update_c_tuple(Node, Es);
+		true ->
+		    Es1 = wrap(Es, Node, Vars),
+		    cerl:update_c_call(Node,
+				       cerl:abstract(hybrid),
+				       cerl:abstract(tuple),
+				       [cerl:make_list(Es1)])
+%%% 		    cerl:update_c_call(Node, cerl:abstract(hybrid),
+%%% 				       cerl:abstract(tuple), Es1)
+	    end;
+	cons ->
+	    H = rewrite(cerl:cons_hd(Node), Vars),
+	    T = rewrite(cerl:cons_tl(Node), Vars),
+	    case is_escaping(Node) of
+		false ->
+		    cerl:update_c_cons(Node, H, T);
+		true ->
+		    Es = wrap([H, T], Node, Vars),
+		    cerl:update_c_call(Node,
+				       cerl:abstract(hybrid),
+				       cerl:abstract(cons),
+				       Es)
+	    end;
+%%% 	call ->
+%%% 	    M = rewrite(cerl:call_module(Node)),
+%%% 	    F = rewrite(cerl:call_name(Node)),
+%%% 	    As = rewrite_list(cerl:call_args(Node)),
+%%% 	    case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
+%%% 		true ->
+%%% 		    case {cerl:atom_val(M), cerl:atom_val(F), length(As)} of
+%%% 			{erlang, '!', 2} ->
+%%% 			    cerl:update_c_call(Node,
+%%% 					       cerl:abstract(hipe_bifs),
+%%% 					       cerl:abstract(send),
+%%% 					       [cerl:make_list(As)]);
+%%% 			_ ->
+%%% 			    cerl:update_c_call(Node, M, F, As)
+%%% 		    end;
+%%% 		false ->
+%%% 		    cerl:update_c_call(Node, M, F, As)
+%%% 	    end;
+	clause ->
+	    B = rewrite(cerl:clause_body(Node), Vars),
+	    cerl:update_c_clause(Node, cerl:clause_pats(Node),
+				 cerl:clause_guard(Node), B);
+	primop ->
+	    case cerl:atom_val(cerl:primop_name(Node)) of
+		match_fail ->
+		    Node;
+		_ ->
+		    As = rewrite_list(cerl:primop_args(Node), Vars),
+		    cerl:update_c_primop(Node, cerl:primop_name(Node), As)
+	    end;
+	_T ->
+	    case cerl:subtrees(Node) of
+		[] ->
+		    Node;
+		Gs ->
+		    cerl:update_tree(Node, [rewrite_list(Ns, Vars)
+					    || Ns <- Gs])
+	    end
+    end.
+
+rewrite_list([N | Ns], Vars) ->
+    [rewrite(N, Vars) | rewrite_list(Ns, Vars)];
+rewrite_list([], _) ->
+    [].
+
+is_escaping(T) ->
+    lists:member(escapes, cerl:get_ann(T)).
+
+wrap(Es, Node, Vars) ->
+    L = cerl_trees:get_label(Node),
+    Xs = dict:fetch(L, Vars),
+    wrap(Es, Xs).
+
+wrap([E | Es], [{S, _} | Xs]) ->
+    case ordsets:is_element(unsafe, S) of
+%%  case cerl:type(E) =/= literal of
+	true ->
+	    [cerl:c_call(cerl:abstract(hybrid),
+			 cerl:abstract(copy),
+			 [E])
+	     | wrap(Es, Xs)];
+	false ->
+	    [E | wrap(Es, Xs)]
+    end;
+wrap([], _) ->
+    [].
diff --git a/lib/hipe/cerl/cerl_lib.erl b/lib/hipe/cerl/cerl_lib.erl
new file mode 100644
index 0000000000..83bb20e047
--- /dev/null
+++ b/lib/hipe/cerl/cerl_lib.erl
@@ -0,0 +1,462 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+%% @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/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl
new file mode 100644
index 0000000000..0753376e7d
--- /dev/null
+++ b/lib/hipe/cerl/cerl_messagean.erl
@@ -0,0 +1,1105 @@
+%% =====================================================================
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% Message analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2002 Richard Carlsson
+%%
+%% Author contact: [email protected]
+%% =====================================================================
+
+%% TODO: might need a "top" (`any') element for any-length value lists.
+
+-module(cerl_messagean).
+
+-export([annotate/1]).
+
+-import(cerl, [alias_pat/1, alias_var/1, ann_c_var/2, ann_c_fun/3,
+	       apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
+	       bitstr_val/1, binary_segments/1, c_letrec/2,
+	       ann_c_tuple/2, 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, 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_vars/1,
+	       try_evars/1, try_handler/1, tuple_es/1, type/1,
+	       values_es/1]).
+
+-import(cerl_trees, [get_label/1]).
+
+-define(DEF_LIMIT, 4).
+
+%% -export([test/1, test1/1, ttest/1]).
+
+%% ttest(F) ->
+%%     {T, _} = cerl_trees:label(user_default:read(F)),
+%%     {Time0, _} = erlang:statistics(runtime),
+%%     analyze(T),
+%%     {Time1, _} = erlang:statistics(runtime),
+%%     Time1 - Time0.
+
+%% test(F) ->
+%%     {T, _} = cerl_trees:label(user_default:read(F)),
+%%     {Time0, _} = erlang:statistics(runtime),
+%%     {Esc, _Vars} = analyze(T),
+%%     {Time1, _} = erlang:statistics(runtime),
+%%     io:fwrite("messages: ~p.\n", [Esc]),
+%%     Set = sets:from_list(Esc),
+%%     H = fun (Node, Ctxt, Cont) ->
+%% 		Doc = case get_ann(Node) of
+%% 			  [{label, L} | _] ->
+%% 			      B = sets:is_element(L, Set),
+%% 			      bf(Node, Ctxt, Cont, B);
+%% 			  _ ->
+%% 			      bf(Node, Ctxt, Cont, false)
+%% 		      end,
+%% 		case type(Node) of
+%% 		    cons -> color(Doc);
+%% 		    tuple -> color(Doc);
+%% 		    _ -> Doc
+%% 		end
+%% 	end,
+%%     {ok, FD} = file:open("out.html",[write]),
+%%     Txt = cerl_prettypr:format(T, [{hook, H},{user,false}]),
+%%     io:put_chars(FD, "<pre>\n"),
+%%     io:put_chars(FD, html(Txt)),
+%%     io:put_chars(FD, "</pre>\n"),
+%%     file:close(FD),
+%%     {ok, Time1 - Time0}.
+
+%% test1(F) ->
+%%     {T, _} = cerl_trees:label(user_default:read(F)),
+%%     {Time0, _} = erlang:statistics(runtime),
+%%     {T1, Esc, Vars} = annotate(T),
+%%     {Time1, _} = erlang:statistics(runtime),
+%%     io:fwrite("messages: ~p.\n", [Esc]),
+%% %%%     io:fwrite("vars: ~p.\n", [[X || X <- dict:to_list(Vars)]]),
+%%     T2 = hhl_transform:transform(T1, Vars),
+%%     Set = sets:from_list(Esc),
+%%     H = fun (Node, Ctxt, Cont) ->
+%% 		case get_ann(Node) of
+%% 		    [{label, L} | _] ->
+%% 			B = sets:is_element(L, Set),
+%% 			bf(Node, Ctxt, Cont, B);
+%% 		    _ ->
+%% 			bf(Node, Ctxt, Cont, false)
+%% 		end
+%%     end,
+%%     {ok, FD} = file:open("out.html",[write]),
+%%     Txt = cerl_prettypr:format(T2, [{hook, H},{user,false}]),
+%%     io:put_chars(FD, "<pre>\n"),
+%%     io:put_chars(FD, html(Txt)),
+%%     io:put_chars(FD, "</pre>\n"),
+%%     file:close(FD),
+%%     {ok, Time1 - Time0}.
+
+%% html(Cs) ->
+%%     html(Cs, []).
+
+%% html([$#, $< | Cs], As) ->
+%%     html_1(Cs, [$< | As]);
+%% html([$< | Cs], As) ->
+%%     html(Cs, ";tl&" ++ As);
+%% html([$> | Cs], As) ->
+%%     html(Cs, ";tg&" ++ As);
+%% html([$& | Cs], As) ->
+%%     html(Cs, ";pma&" ++ As);
+%% html([C | Cs], As) ->
+%%     html(Cs, [C | As]);
+%% html([], As) ->
+%%     lists:reverse(As).
+
+%% html_1([$> | Cs], As) ->
+%%     html(Cs, [$> | As]);
+%% html_1([C | Cs], As) ->
+%%     html_1(Cs, [C | As]).
+
+%% bf(Node, Ctxt, Cont, B) ->
+%%     B0 = cerl_prettypr:get_ctxt_user(Ctxt),
+%%     if B /= B0 ->
+%% 	    Ctxt1 = cerl_prettypr:set_ctxt_user(Ctxt, B),
+%% 	    Doc = Cont(Node, Ctxt1),
+%% 	    case B of
+%% 		true ->
+%% 		    Start = "<b>",
+%% 		    End = "</b>";
+%% 		false ->
+%% 		    Start = "</b>",
+%% 		    End = "<b>"
+%% 	    end,
+%% 	    markup(Doc, Start, End);
+%%        true ->
+%% 	    Cont(Node, Ctxt)
+%%     end.
+
+%% color(Doc) ->
+%% %    Doc.
+%%     markup(Doc, "<font color=blue>", "</font>").
+
+%% markup(Doc, Start, End) ->
+%%     prettypr:beside(
+%%       prettypr:null_text([$# | Start]),
+%%       prettypr:beside(Doc,
+%% 		      prettypr:null_text([$# | End]))).
+
+
+%% =====================================================================
+%% annotate(Tree) -> {Tree1, Escapes, Vars}
+%%
+%%	    Tree = cerl:cerl()
+%%
+%%	Analyzes `Tree' (see `analyze') and appends a term 'escapes', to
+%%	the annotation list of each constructor expression node and of
+%%	`Tree', corresponding to the escape 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.
+
+-type label()   :: integer() | 'external' | 'top'.
+-type ordset(X) :: [X].  % XXX: TAKE ME OUT
+
+-spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict()}.
+
+annotate(Tree) ->
+    {Esc0, Vars} = analyze(Tree),
+    Esc = sets:from_list(Esc0),
+    F = fun (T) ->
+		case type(T) of
+		    literal -> T;
+%%% 		    var ->
+%%% 			L = get_label(T),
+%%% 			T1 = ann_escape(T, L, Esc),
+%%% 			X = dict:fetch(L, Vars),
+%%% 			set_ann(T1, append_ann({s,X}, get_ann(T1)));
+		    _ ->
+			L = get_label(T),
+			ann_escape(T, L, Esc)
+		end
+	end,
+    {cerl_trees:map(F, Tree), Esc0, Vars}.
+
+ann_escape(T, L, Esc) ->
+    case sets:is_element(L, Esc) of
+	true ->
+	    set_ann(T, append_ann(escapes, get_ann(T)));
+	false ->
+	    T
+    end.
+
+append_ann(Tag, [X | Xs]) ->
+    if tuple_size(X) >= 1, element(1, X) =:= Tag -> 
+	    append_ann(Tag, Xs);
+       true ->
+	    [X | append_ann(Tag, Xs)]
+    end;
+append_ann(Tag, []) ->
+    [Tag].
+
+
+%% =====================================================================
+%% analyze(Tree) -> Escapes
+%%
+%%	    Tree = cerl:cerl()
+%%	    Escapes = ordset(Label)
+%%	    Label = integer() | external | top
+%%
+%%	Analyzes a module or an expression represented by `Tree'.
+%%
+%%	`Escapes' is the set of labels of constructor expressions in
+%%	`Tree' such that the created values 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, {vars, out, dep, work, funs, k}).
+
+%% Note: We assume that all remote calls and primops return a single
+%% value.
+
+%% The analysis determines which objects (identified by the
+%% corresponding "cons-point" labels in the code) are likely to be
+%% passed in a message. (If so, we say that they "escape".) It is always
+%% safe to assume either case, because the send operation will assure
+%% that things are copied if necessary. This analysis tries to
+%% anticipate that copying will be done.
+%%
+%% Rules:
+%%   1) An object passed as message argument (or part of such an
+%%   argument) to a known send-operation, will probably be a message.
+%%   2) A received value is always a message (safe).
+%%   3) The external function can return any object (unsafe).
+%%   4) A function called from the external function can receive any
+%%   object (unsafe) as argument.
+%%   5) Unknown functions/operations can return any object (unsafe).
+
+%% 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 () -> Any", which will represent any and all
+%% functions outside T, and which returns the 'unsafe' value.
+
+analyze(Tree) ->
+    analyze(Tree, ?DEF_LIMIT).
+
+analyze(Tree, Limit) ->
+    {_, _, Esc, Dep, _Par} = cerl_closurean:analyze(Tree),
+%%%     io:fwrite("dependencies: ~w.\n", [dict:to_list(Dep)]),
+    analyze(Tree, Limit, Dep, Esc).
+
+analyze(Tree, Limit, Dep0, Esc0) ->
+    %% 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.
+    Any = ann_c_var([{label, any}], 'Any'),
+    External = ann_c_var([{label, external}], {external, 1}),
+    ExtFun = ann_c_fun([{label, external}], [], Any),
+%%%     io:fwrite("external fun:\n~s.\n",
+%%%   	      [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
+    Top = ann_c_var([{label, top}], {top, 0}),
+    TopFun = ann_c_fun([{label, top}], [], 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}])]),
+
+    %% Initialise the Any and Escape variables. 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. Bind all module- and letrec-defined variables to their
+    %% corresponding labels.
+    Esc = sets:from_list(Esc0),
+    Unsafe = unsafe(),
+    Empty = empty(),
+    Funs0 = dict:new(),
+    Vars0 = dict:store(escape, empty(), 
+		       dict:store(any, Unsafe, dict:new())),
+    Out0 = dict:new(),
+    F = fun (T, S = {Fs, Vs, Os}) ->
+		case type(T) of
+		    'fun' ->
+			L = get_label(T),
+			As = fun_vars(T),
+			X = case sets:is_element(L, Esc) of
+				true -> Unsafe;
+				false -> Empty
+			    end,
+			{dict:store(L, T, Fs),
+			 bind_vars_single(As, X, 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),
+
+    %% Add the dependency for the loop in 'external':
+    Dep = add_dep(loop, external, Dep0),
+
+    %% Enter the fixpoint iteration at the StartFun.
+    St = loop(StartFun, start, #state{vars = Vars,
+				      out = Out,
+				      dep = Dep,
+				      work = init_work(),
+				      funs = Funs,
+				      k = Limit}),
+    Ms = labels(dict:fetch(escape, St#state.vars)),
+    {Ms, St#state.vars}.
+
+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),
+    {Xs1, St1} = visit(fun_body(T), L, St0),
+    Xs = limit(Xs1, St1#state.k),
+    {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) ->
+%%%     io:fwrite("visiting: ~w.\n",[type(T)]),
+    case type(T) of
+	literal ->
+	    %% This is (or should be) a constant, even if it's compound,
+	    %% so it's bugger all whether it is sent or not.
+	    case cerl:concrete(T) of
+		[] -> {[empty()], St};
+		X when is_atom(X) -> {[empty()], St};
+		X when is_integer(X) -> {[empty()], St};
+		X when is_float(X) -> {[empty()], St};
+		_ ->
+		    exit({not_literal, T})
+	    end;
+	var ->
+	    %% If a variable is not already in the store here, it must
+	    %% be free in the program.
+	    L1 = get_label(T),
+	    Vars = St#state.vars,
+	    case dict:find(L1, Vars) of
+		{ok, X} ->
+		    {[X], St};
+		error ->
+%%% 		    io:fwrite("free var: ~w.\n",[L1]),
+		    X = unsafe(),
+		    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)},
+	    %% Currently, lambda expressions can only be locally
+	    %% allocated, and therefore we have to force copying by
+	    %% treating them as "unsafe" for now.
+	    {[unsafe()], St1};
+	    %% {[singleton(L1)], St1};
+	values ->
+	    visit_list(values_es(T), L, St);
+	cons ->
+	    {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
+	    L1 = get_label(T),
+	    X = make_cons(L1, X1, X2),
+	    %% Also store the values of the elements.
+ 	    Hd = get_hd(X),
+ 	    Tl = get_tl(X),
+ 	    St2 = St1#state{vars = dict:store(L1, [Hd, Tl], St1#state.vars)},
+	    {[X], St2};
+	tuple ->
+	    {Xs, St1} = visit_list(tuple_es(T), L, St),
+	    L1 = get_label(T),
+	    %% Also store the values of the elements.
+	    St2 = St1#state{vars = dict:store(L1, Xs, St1#state.vars)},
+	    {[struct(L1, Xs)], St2};
+	'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 ->
+	    {_F, St1} = visit(apply_op(T), L, St),
+	    {As, St2} = visit_list(apply_args(T), L, St1),
+	    L1 = get_label(T),
+	    Ls = get_deps(L1, St#state.dep),
+	    Out = St2#state.out,
+	    Xs1 = join_list([dict:fetch(X, Out) || X <- Ls]),
+	    {Xs1, call_site(Ls, As, St2)};
+	call ->
+	    M = call_module(T),
+	    F = call_name(T),
+	    As = call_args(T),
+	    {_, St1} = visit(M, L, St),
+	    {_, St2} = visit(F, L, St1),
+	    {Xs, St3} = visit_list(As, L, St2),
+	    L1 = get_label(T),
+	    remote_call(M, F, Xs, As, L1, St3);
+	primop ->
+ 	    As = primop_args(T),
+ 	    {Xs, St1} = visit_list(As, L, St),
+ 	    F = atom_val(primop_name(T)),
+ 	    primop_call(F, length(Xs), Xs, As, St1);
+	'case' ->
+	    {Xs, St1} = visit(case_arg(T), L, St),
+	    visit_clauses(Xs, case_clauses(T), L, St1);
+	'receive' ->
+	    %% The received value is of course a message, so it
+	    %% is 'empty()', not 'unsafe()'.
+	    X = empty(),
+	    {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 = unsafe(),
+	    Vars = bind_vars(try_vars(T), Xs1, 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(Xs2, Xs3), St3};
+	'catch' ->
+	    %% If we catch an exception, we can get unsafe data.
+	    {Xs, St1} = visit(catch_body(T), L, St),
+	    {join([unsafe()], Xs), St1};
+	binary ->
+	    %% Binaries are heap objects, but we don't have special
+	    %% shared-heap allocation operators for them at the moment.
+	    %% They must therefore be treated as unsafe.
+	    {_, St1} = visit_list(binary_segments(T), L, St),
+	    {[unsafe()], 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)},
+	    visit(letrec_body(T), L, St1);
+	module ->
+	    %% We regard a module as a tuple of function variables in
+	    %% the body of a `letrec'.
+	    visit(c_letrec(module_defs(T),
+			   ann_c_tuple([{label, get_label(T)}],
+				       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;
+	    _ -> empty()
+	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.
+
+%% The lists might not be of the same length.
+
+bind_pats_list([P | Ps], [X | Xs], Vars) ->
+    bind_pats_list(Ps, Xs, bind_pat_vars(P, X, Vars));
+bind_pats_list(Ps, [], Vars) ->
+    bind_pats_single(Ps, empty(), Vars);
+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 ->
+	    bind_pats_list([cons_hd(P), cons_tl(P)],
+			   [get_hd(X), get_tl(X)], Vars);
+	tuple ->
+	    case elements(X) of
+		none ->
+		    bind_vars_single(pat_vars(P), X, Vars);
+		Xs ->
+		    bind_pats_list(tuple_es(P), Xs, Vars)
+	    end;
+	binary ->
+	    %% See the handling of binary-expressions.
+	    bind_pats_single(binary_segments(P), unsafe(), Vars);
+	bitstr ->
+	    %% See the handling of binary-expressions.
+	    bind_pats_single([bitstr_val(P), bitstr_size(P)],
+			     unsafe(), Vars);
+	alias ->
+	    P1 = alias_pat(P),
+	    Vars1 = bind_pat_vars(P1, X, Vars),
+	    dict:store(get_label(alias_var(P)), X, Vars1)
+    end.
+
+%%% %% This is the "exact" version of list representation, which simply
+%%% %% mimics the actual cons, head and tail operations.
+%%% make_cons(L, X1, X2) ->
+%%%     struct(L1, [X1, X2]).
+%%% get_hd(X) ->
+%%%     case elements(X) of
+%%% 	none -> X;
+%%% 	[X1 | _] -> X1;
+%%% 	_ -> empty()
+%%%     end.
+%%% get_tl(X) ->
+%%%     case elements(X) of
+%%%  	none -> X;
+%%%  	[_, X2 | _] -> X2;
+%%%  	_ -> empty()
+%%%     end.
+
+%% This version does not unnecessarily confuse spine labels with element
+%% labels, and is safe. However, it loses precision if cons cells are
+%% used for other things than proper lists.
+
+make_cons(L, X1, X2) ->
+    %% join subtypes and cons locations
+    join_single(struct(L, [X1]), X2).
+
+get_hd(X) ->
+    case elements(X) of
+ 	none -> X;
+ 	[X1 | _] -> X1;    % First element represents list subtype.
+ 	_ -> empty()
+    end.
+
+get_tl(X) -> X.   % Tail of X has same type as X.
+
+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, updating parameter variables with respect
+%% to the actual parameters. The 'external' function is handled
+%% specially, since it can get an arbitrary number of arguments. For our
+%% purposes here, calls to the external function can be ignored.
+
+call_site(Ls, Xs, St) ->
+%%%     io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, 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([external | Ls], Xs, W, V, Fs, Limit) ->
+    call_site(Ls, Xs, W, V, Fs, Limit);
+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}.
+
+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, 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_single(join_single(X, X0), Limit),
+    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(Xs, Ns, St) ->
+    escape(Xs, Ns, 1, St).
+
+escape([_ | Xs], Ns=[N1 | _], N, St) when is_integer(N1), N1 > N ->
+    escape(Xs, Ns, N + 1, St);
+escape([X | Xs], [N | Ns], N, St) ->
+    Vars = St#state.vars,
+    X0 = dict:fetch(escape, Vars),
+    X1 = join_single(X, X0),
+    case equal_single(X0, X1) of
+	true ->
+	    escape(Xs, Ns, N + 1, St);
+	false ->
+%%%    	    io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
+	    Vars1 = dict:store(escape, X1, Vars),
+	    escape(Xs, Ns, N + 1, St#state{vars = Vars1})
+    end;
+escape(Xs, [_ | Ns], N, St) ->
+    escape(Xs, Ns, N + 1, St);
+escape(_, _, _, St) ->
+    St.
+
+%% Handle primop calls: (At present, we assume that all unknown calls
+%% yield exactly one value. This might have to be changed.)
+
+primop_call(F, A, Xs, _As, St0) ->
+    %% St1 = case is_escape_op(F, A) of
+    %%	      [] -> St0;
+    %%	      Ns -> escape(Xs, Ns, St0)
+    %%	  end,
+    St1 = St0,
+    case is_imm_op(F, A) of
+	true ->
+	    {[empty()], St1};
+	false ->
+	    call_unknown(Xs, St1)
+    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, As, L, 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, As, L, St);
+	false ->
+	    %% Unknown function
+	    call_unknown(Xs, St)
+    end.
+
+%% When calling an unknown function, we assume that the result does
+%% *not* contain any of the constructors in its arguments (but it could
+%% return locally allocated data that we don't know about). Note that
+%% even a "pure" function can still cons up new data.
+
+call_unknown(_Xs, St) ->
+    {[unsafe()], St}.
+
+%% We need to handle some important standard functions in order to get
+%% decent precision.
+%% TODO: foldl, map, mapfoldl
+
+remote_call_1(erlang, hd, 1, [X], _As, _L, St) ->
+    {[get_hd(X)], St};
+remote_call_1(erlang, tl, 1, [X], _As, _L, St) ->
+    {[get_tl(X)], St};
+remote_call_1(erlang, element, 2, [_,X], [N|_], _L, St) ->
+    case elements(X) of
+	none -> {[X], St};
+	Xs ->
+	    case is_c_int(N) of
+		true ->
+		    N1 = int_val(N),
+		    if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
+			    {[nth(N1, Xs)], St};
+		       true ->
+			    {none, St}
+		    end;
+		false ->
+		    %% Even if we don't know which element is selected,
+		    %% we know that the top level is never part of the
+		    %% returned value.
+		    {[join_single_list(Xs)], St}
+	    end
+    end;
+remote_call_1(erlang, setelement, 3, [_,X, Y], [N|_], L, St) ->
+    %% The constructor gets the label of the call operation.
+    case elements(X) of
+	none -> {[join_single(singleton(L), join_single(X, Y))], St};
+	Xs ->
+	    case is_c_int(N) of
+		true ->
+		    N1 = int_val(N),
+		    if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
+			    Xs1 = set_nth(N1, Y, Xs),
+			    {[struct(L, Xs1)], St};
+		       true ->
+			    {none, St}
+		    end;
+		false ->
+		    %% Even if we don't know which element is selected,
+		    %% we know that the top level is never part of the
+		    %% returned value (a new tuple is always created).
+		    Xs1 = [join_single(Y, X1) || X1 <- Xs],
+		    {[struct(L, Xs1)], St}
+	    end
+    end;
+remote_call_1(erlang, '++', 2, [X1,X2], _As, _L, St) ->
+    %% Note: this is unsafe for non-proper lists! (See make_cons/3).
+    %% No safe version is implemented.
+    {[join_single(X1, X2)], St};
+remote_call_1(erlang, '--', 2, [X1,_X2], _As, _L, St) ->
+    {[X1], St};
+remote_call_1(lists, append, 2, Xs, As, L, St) ->
+    remote_call_1(erlang, '++', 2, Xs, As, L, St);
+remote_call_1(lists, subtract, 2, Xs, As, L, St) ->
+    remote_call_1(erlang, '--', 2, Xs, As, L, St);
+remote_call_1(M, F, A, Xs, _As, _L, St0) ->
+    St1 = case is_escape_op(M, F, A) of
+	      [] -> St0;
+	      Ns -> escape(Xs, Ns, St0)
+	  end,
+    case is_imm_op(M, F, A) of
+	true ->
+	    {[empty()], St1};
+	false ->
+	    call_unknown(Xs, St1)
+    end.
+
+%% 1-based n:th-element list selector and update function.
+
+nth(1, [X | _Xs]) -> X;
+nth(N, [_X | Xs]) when N > 1 -> nth(N - 1, Xs).
+
+set_nth(1, Y, [_X | Xs]) -> [Y | Xs];
+set_nth(N, Y, [X | Xs]) when N > 1 -> [X | set_nth(N - 1, Y, Xs)].
+
+%% Domain: none | [V], where V = {S, none} | {S, [V]}, S = 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([], []) ->
+    [].
+
+join_list([Xs | Xss]) ->
+    join(Xs, join_list(Xss));
+join_list([]) ->
+    none.
+
+empty() -> {set__new(), []}.
+
+singleton(X) -> {set__singleton(X), []}.
+
+struct(X, Xs) -> {set__singleton(X), Xs}.
+
+elements({_, Xs}) -> Xs.
+
+unsafe() -> {set__singleton(unsafe), none}.
+
+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({S1, none}, {S2, none}) ->
+    set__equal(S1, S2);
+equal_single({_, none}, _) ->
+    false;
+equal_single(_, {_, none}) ->
+    false;
+equal_single({S1, Vs1}, {S2, Vs2}) ->
+    set__equal(S1, S2) andalso equal_single_lists(Vs1, Vs2).
+
+equal_single_lists([X1 | Xs1], [X2 | Xs2]) ->
+    equal_single(X1, X2) andalso equal_single_lists(Xs1, Xs2);
+equal_single_lists([], []) ->
+    true;
+equal_single_lists(_, _) ->
+    false.
+
+join_single({S, none}, V) ->
+    {set__union(S, labels(V)), none};
+join_single(V, {S, none}) ->
+    {set__union(S, labels(V)), none};
+join_single({S1, Vs1}, {S2, Vs2}) ->
+    {set__union(S1, S2), join_single_lists(Vs1, Vs2)}.
+
+join_single_list([V | Vs]) ->
+    join_single(V, join_single_list(Vs));
+join_single_list([]) ->
+    empty().
+
+%% If one list has more elements that the other, and N is the length of
+%% the longer list, then the result has N elements.
+
+join_single_lists([V1], [V2]) ->
+    [join_single(V1, V2)];
+join_single_lists([V1 | Vs1], [V2 | Vs2]) ->
+    [join_single(V1, V2) | join_single_lists(Vs1, Vs2)];
+join_single_lists([], Vs) -> Vs;
+join_single_lists(Vs, []) -> Vs.
+
+collapse(V) ->
+    {labels(V), none}.
+
+%% collapse_list([]) ->
+%%     empty();
+%% collapse_list(Vs) ->
+%%     {labels_list(Vs), none}.
+
+labels({S, none}) -> S;
+labels({S, []}) -> S;
+labels({S, Vs}) -> set__union(S, labels_list(Vs)).
+
+labels_list([V]) ->
+    labels(V);
+labels_list([V | Vs]) ->
+    set__union(labels(V), labels_list(Vs)).
+
+limit(none, _K) -> none;
+limit(X, K) -> limit_list(X, K).
+
+limit_list([X | Xs], K) ->
+    [limit_single(X, K) | limit_list(Xs, K)];
+limit_list([], _) ->
+    [].
+
+limit_single({_, none} = V, _K) ->
+    V;
+limit_single({_, []} = V, _K) ->
+    V;
+limit_single({S, Vs}, K) when K > 0 ->
+    {S, limit_list(Vs, K - 1)};
+limit_single(V, _K) ->
+    collapse(V).
+
+%% Set abstraction for label sets in the domain.
+
+%% set__is_empty([]) -> true;
+%% set__is_empty(_) -> false.
+
+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.
+
+get_deps(L, Dep) ->
+    case dict:find(L, Dep) of
+	{ok, Ls} -> Ls;
+	error -> []
+    end.
+
+%% Escape operators may let their arguments escape. For this analysis,
+%% only send-operations are considered as causing escapement, and only
+%% in specific arguments.
+
+%% is_escape_op(_F, _A) -> [].
+
+-spec is_escape_op(module(), atom(), arity()) -> [arity()].
+
+is_escape_op(erlang, '!', 2) -> [2];
+is_escape_op(erlang, send, 2) -> [2];
+is_escape_op(erlang, spawn, 1) -> [1];
+is_escape_op(erlang, spawn, 3) -> [3];
+is_escape_op(erlang, spawn, 4) -> [4];
+is_escape_op(erlang, spawn_link, 3) -> [3];
+is_escape_op(erlang, spawn_link, 4) -> [4];
+is_escape_op(_M, _F, _A) -> [].
+
+%% "Immediate" operators will never return heap allocated data. This is
+%% of course true for operators that never return, like 'exit/1'. (Note
+%% that floats are always heap allocated objects, and that most integer
+%% arithmetic can return a bignum on the heap.)
+
+-spec is_imm_op(atom(), arity()) -> boolean().
+
+is_imm_op(match_fail, 1) -> true; 
+is_imm_op(_, _) -> false.
+
+-spec is_imm_op(module(), atom(), arity()) -> boolean().
+
+is_imm_op(erlang, self, 0) -> true;
+is_imm_op(erlang, '=:=', 2) -> true;
+is_imm_op(erlang, '==', 2) -> true;
+is_imm_op(erlang, '=/=', 2) -> true;
+is_imm_op(erlang, '/=', 2) -> true;
+is_imm_op(erlang, '<', 2) -> true;
+is_imm_op(erlang, '=<', 2) -> true;
+is_imm_op(erlang, '>', 2) -> true;
+is_imm_op(erlang, '>=', 2) -> true;
+is_imm_op(erlang, 'and', 2) -> true;
+is_imm_op(erlang, 'or', 2) -> true;
+is_imm_op(erlang, 'xor', 2) -> true;
+is_imm_op(erlang, 'not', 1) -> true;
+is_imm_op(erlang, is_alive, 0) -> true;
+is_imm_op(erlang, is_atom, 1) -> true;
+is_imm_op(erlang, is_binary, 1) -> true;
+is_imm_op(erlang, is_builtin, 3) -> true;
+is_imm_op(erlang, is_constant, 1) -> true;
+is_imm_op(erlang, is_float, 1) -> true;
+is_imm_op(erlang, is_function, 1) -> true;
+is_imm_op(erlang, is_integer, 1) -> true;
+is_imm_op(erlang, is_list, 1) -> true;
+is_imm_op(erlang, is_number, 1) -> true;
+is_imm_op(erlang, is_pid, 1) -> true;
+is_imm_op(erlang, is_port, 1) -> true;
+is_imm_op(erlang, is_process_alive, 1) -> true;
+is_imm_op(erlang, is_reference, 1) -> true;
+is_imm_op(erlang, is_tuple, 1) -> true;
+is_imm_op(erlang, length, 1) -> true;    % never a bignum
+is_imm_op(erlang, list_to_atom, 1) -> true;
+is_imm_op(erlang, node, 0) -> true;
+is_imm_op(erlang, node, 1) -> true;
+is_imm_op(erlang, throw, 1) -> true;
+is_imm_op(erlang, exit, 1) -> true;
+is_imm_op(erlang, error, 1) -> true;
+is_imm_op(erlang, error, 2) -> true;
+is_imm_op(_, _, _) -> false.
diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl
new file mode 100644
index 0000000000..3bc93e80dd
--- /dev/null
+++ b/lib/hipe/cerl/cerl_pmatch.erl
@@ -0,0 +1,624 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2000-2006 Richard Carlsson
+%%
+%% @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).
+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).
+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) -> 
+    Ref = get_unique(),
+    Guard = cerl:c_primop(cerl:c_atom(set_label), [cerl:c_int(Ref)]),
+    NewElse = cerl:c_primop(cerl:c_atom(goto_label), [cerl:c_int(Ref)]),
+    Body = match(Vs, Cs, NewElse, Env),
+    cerl:c_clause([make_pat(?binary_id, Segs)], Guard, 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).
+expr(E, Env) ->
+    case cerl:type(E) of
+ 	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.
+
+
+get_unique() ->
+  case get(unique_label) of
+    undefined ->
+      put(unique_label, 1),
+      0;
+    N ->
+      put(unique_label, N+1),
+      N
+  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/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl
new file mode 100644
index 0000000000..fba9a48cda
--- /dev/null
+++ b/lib/hipe/cerl/cerl_prettypr.erl
@@ -0,0 +1,883 @@
+%% =====================================================================
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% Core Erlang prettyprinter, using the 'prettypr' module.
+%%
+%% Copyright (C) 1999-2002 Richard Carlsson
+%%
+%% Author contact: [email protected]
+%% =====================================================================
+%%
+%% @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]).
+
+-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);
+	'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_binary(V) ->
+	    lay_binary(c_binary([c_bitstr(abstract(B),
+					  abstract(8),
+					  abstract(1),
+					  abstract(integer),
+					  abstract([unsigned, big]))
+				 || B <- binary_to_list(V)]),
+		       Ctxt);
+	[] ->
+	    text("[]");
+	[_ | _] ->
+	    %% `lay_cons' will check for strings.
+	    lay_cons(Node, Ctxt);
+	V when is_tuple(V) ->
+	    lay_tuple(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_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/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl
new file mode 100644
index 0000000000..362c427cbe
--- /dev/null
+++ b/lib/hipe/cerl/cerl_to_icode.erl
@@ -0,0 +1,2717 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% @author Richard Carlsson <[email protected]>
+%% @copyright 2000-2006 Richard Carlsson
+%% @doc Translation from Core Erlang to HiPE Icode.
+
+%% TODO: annotate Icode leaf functions as such.
+%% TODO: add a pass to remove unnecessary reduction tests
+%% TODO: generate branch prediction info?
+
+-module(cerl_to_icode).
+
+-define(NO_UNUSED, true).
+
+-export([module/2]).
+-ifndef(NO_UNUSED).
+-export([function/3, function/4, module/1]).
+-endif.
+
+%% Added in an attempt to suppress message by Dialyzer, but I run into
+%% an internal compiler error in the old inliner and commented it out.
+%% The inlining is performed manually instead :-(             - Kostis
+%% -compile({inline, [{error_fun_value,1}]}).
+
+%% ---------------------------------------------------------------------
+%% Macros and records
+
+%% Icode primitive operation names
+
+-include("../icode/hipe_icode_primops.hrl").
+
+-define(OP_REDTEST, redtest).
+-define(OP_CONS, cons).
+-define(OP_TUPLE, mktuple).
+-define(OP_ELEMENT, {erlang,element,2}).  %% This has an MFA name
+-define(OP_UNSAFE_HD, unsafe_hd).
+-define(OP_UNSAFE_TL, unsafe_tl).
+-define(OP_UNSAFE_ELEMENT(N), #unsafe_element{index=N}).
+-define(OP_UNSAFE_SETELEMENT(N), #unsafe_update_element{index=N}).
+-define(OP_CHECK_GET_MESSAGE, check_get_msg).
+-define(OP_NEXT_MESSAGE, next_msg).
+-define(OP_SELECT_MESSAGE, select_msg).
+-define(OP_SET_TIMEOUT, set_timeout).
+-define(OP_CLEAR_TIMEOUT, clear_timeout).
+-define(OP_WAIT_FOR_MESSAGE, suspend_msg).
+-define(OP_APPLY_FIXARITY(N), #apply_N{arity=N}).
+-define(OP_MAKE_FUN(M, F, A, U, I), #mkfun{mfa={M,F,A}, magic_num=U, index=I}).
+-define(OP_FUN_ELEMENT(N), #closure_element{n=N}).
+-define(OP_BS_CONTEXT_TO_BINARY, {hipe_bs_primop,bs_context_to_binary}).
+
+%% Icode conditional tests
+
+-define(TEST_EQ, '==').
+-define(TEST_NE, '/=').
+-define(TEST_EXACT_EQ, '=:=').
+-define(TEST_EXACT_NE, '=/=').
+-define(TEST_LT, '<').
+-define(TEST_GT, '>').
+-define(TEST_LE, '=<').
+-define(TEST_GE, '>=').
+-define(TEST_WAIT_FOR_MESSAGE_OR_TIMEOUT, suspend_msg_timeout).
+
+%% Icode type tests
+
+-define(TYPE_ATOM(X), {atom, X}).
+-define(TYPE_INTEGER(X), {integer, X}).
+-define(TYPE_FIXNUM(X), {integer, X}).    % for now
+-define(TYPE_CONS, cons).
+-define(TYPE_NIL, nil).
+-define(TYPE_IS_N_TUPLE(N), {tuple, N}).
+-define(TYPE_IS_ATOM, atom).
+-define(TYPE_IS_BIGNUM, bignum).
+-define(TYPE_IS_BINARY, binary).
+-define(TYPE_IS_CONSTANT, constant).
+-define(TYPE_IS_FIXNUM, fixnum).
+-define(TYPE_IS_FLOAT, float).
+-define(TYPE_IS_FUNCTION, function).
+-define(TYPE_IS_INTEGER, integer).
+-define(TYPE_IS_LIST, list).
+-define(TYPE_IS_NUMBER, number).
+-define(TYPE_IS_PID, pid).
+-define(TYPE_IS_PORT, port).
+-define(TYPE_IS_RECORD(Atom_, Size_), {record, Atom_, Size_}).
+-define(TYPE_IS_REFERENCE, reference).
+-define(TYPE_IS_TUPLE, tuple).
+
+%% Record definitions
+
+-record(ctxt, {final = false :: boolean(),
+	       effect = false,
+	       fail = [],		% [] or fail-to label
+	       class = expr,		% expr | guard
+	       line = 0,		% current line number
+	       'receive'		% undefined | #receive{}
+	      }).		
+
+-record('receive', {loop}).
+-record(cerl_to_icode__var, {name}).
+-record('fun', {label, vars}).
+
+
+%% ---------------------------------------------------------------------
+%% Code
+
+
+%% @spec module(Module::cerl()) -> [icode()]
+%% @equiv module(Module, [])
+
+-ifndef(NO_UNUSED).
+module(E) ->
+    module(E, []).
+-endif.
+%% @clear
+
+
+%% @spec module(Module::cerl(), Options::[term()]) -> [icode()]
+%%
+%%	    cerl() = cerl:cerl()
+%%	    icode() = hipe_icode:icode()
+%%
+%% @doc Transforms a Core Erlang module to linear HiPE Icode. The result
+%% is a list of Icode function definitions. Currently, no options are
+%% available.
+%%
+%% <p>This function first calls the {@link cerl_hipeify:transform/2}
+%% function on the module.</p>
+%%
+%% <p>Note: Except for the module name, which is included in the header
+%% of each Icode function definition, the remaining information (exports
+%% and attributes) associated with the module definition is not included
+%% in the resulting Icode.</p>
+%%
+%% @see function/4
+%% @see cerl_hipeify:transform/1
+
+%% -spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}].
+
+module(E, Options) ->
+    module_1(cerl_hipeify:transform(E, Options), Options).
+
+module_1(E, Options) ->
+    M = cerl:atom_val(cerl:module_name(E)),
+    if is_atom(M) ->
+	    ok;
+       true ->
+	    error_msg("bad module name: ~P.", [M, 5]),
+	    throw(error)
+    end,
+    S0 = init(M),
+    S1 =  s__set_pmatch(proplists:get_value(pmatch, Options), S0),
+    S2 =  s__set_bitlevel_binaries(proplists:get_value(
+				      bitlevel_binaries, Options), S1),
+    {Icode, _} = lists:mapfoldl(fun function_definition/2,
+				S2, cerl:module_defs(E)),
+    Icode.
+
+%% For now, we simply assume that all function bodies should have degree
+%% one (i.e., return exactly one value). We clear the code ackumulator
+%% before we start compiling each function.
+
+function_definition({V, F}, S) ->
+    S1 = s__set_code([], S),
+    {Icode, S2} = function_1(cerl:var_name(V), F, 1, S1),
+    {{icode_icode_name(Icode), Icode}, S2}.
+
+init(Module) ->
+    reset_label_counter(),		     
+    s__new(Module).
+
+%% @spec function(Module::atom(), Name::atom(), Function::cerl()) ->
+%%           icode()
+%% @equiv function(Module, Name, Fun, 1)
+
+-ifndef(NO_UNUSED).
+function(Module, Name, Fun) ->
+    function(Module, Name, Fun, 1).
+-endif.	% NO_UNUSED
+%% @clear
+
+%% @spec function(Module::atom(), Name::{atom(), integer()},
+%%                Fun::cerl(), Degree::integer()) -> icode()
+%%
+%% @doc Transforms a Core Erlang function to a HiPE Icode function
+%% definition. `Fun' must represent a fun-expression, which may not
+%% contain free variables. `Module' and `Name' specify the module and
+%% function name of the resulting Icode function. Note that the arity
+%% part of `Name' is not necessarily equivalent to the number of
+%% parameters of `Fun' (this can happen e.g., for lifted closure
+%% functions).
+%%
+%% <p>`Degree' specifies the number of values the function is expected
+%% to return; this is typically 1 (one); cf. {@link function/3}.</p>
+%%
+%% <p>Notes: 
+%% <ul>
+%%   <li>This function assumes that the code has been transformed into a
+%%   very simple and explicit form, using the {@link cerl_hipeify}
+%%   module.</li>
+%%
+%%   <li>Several primops (see "`cerl_hipe_primops.hrl'") are
+%%   detected by the translation and handled specially.</li>
+%%
+%%   <li>Tail call optimization is handled, even when the call is
+%%   "hidden" by let-definitions.</li>
+%%
+%%   <li>It is assumed that all `primop' calls in the code represent
+%%   Icode primops or macro instructions, and that all inter-module
+%%   calls (both calls to statically named functions, and dynamic
+%%   meta-calls) represent <em>actual</em> inter-module calls - not
+%%   primitive or built-in operations.</li>
+%%
+%%   <li>The following special form:
+%%     ```case Test of
+%%            'true' when 'true' -> True
+%%            'false' when 'true' -> False
+%%        end'''
+%%   is recognized as an if-then-else switch where `Test' is known
+%%   to always yield 'true' or 'false'. Efficient jumping code is
+%%   generated for such expressions, in particular if nested. Note that
+%%   there must be exactly two clauses; order is not important.</li>
+%%
+%%   <li>Compilation of clauses is simplistic. No pattern matching
+%%   compilation or similar optimizations is done at this stage. Guards
+%%   that are `true' or `false' are recognized as trivially true/false;
+%%   for all other guards, code will be generated. Catch-all clauses
+%%   (with `true' guard and variable-only patterns) are detected, and
+%%   any following clauses are discarded.</li>
+%% </ul></p>
+%%
+%% <p><b>Important</b>: This function does not handle occurrences of
+%% fun-expressions in the body of `Fun', nor `apply'-expressions whose
+%% operators are not locally bound function variables. These must be
+%% transformed away before this function is called, by closure
+%% conversion ({@link cerl_cconv}) using the `make_fun' and `call_fun'
+%% primitive operations to create and apply functional values.</p>
+%%
+%% <p>`receive'-expressions are expected to have a particular
+%% form:
+%% <ul>
+%%   <li>There must be exactly one clause, with the atom
+%%   `true' as guard, and only a single variable as pattern.
+%%   The variable will be bound to a message in the mailbox, and can be
+%%   referred to in the clause body.</li>
+%%
+%%   <li>In the body of that clause, all paths must execute one of the
+%%   primitive operations `receive_select/0' or
+%%   `receive_next/0' before another
+%%   `receive'-statement might be executed.
+%%   `receive_select/0' always returns, but without a value,
+%%   while `receive_next/0' never returns, either causing
+%%   the nearest surrounding receive-expression to be re-tried with the
+%%   next message in the input queue, or timing out.</li>
+%% </ul></p>
+%%
+%% @see function/3
+
+-include("cerl_hipe_primops.hrl").
+
+%% Main translation function:
+
+-ifndef(NO_UNUSED).
+function(Module, Name, Fun, Degree) ->
+    S = init(Module),
+    {Icode, _} = function_1(Name, Fun, Degree, S),
+    Icode.
+-endif.	% NO_UNUSED
+%% @clear
+
+function_1(Name, Fun, Degree, S) ->
+    reset_var_counter(),
+    LowV = max_var(),
+    LowL = max_label(),
+    %% Create input variables for the function parameters, and a list of
+    %% target variables for the result of the function.
+    Args = cerl:fun_vars(Fun),
+    IcodeArity = length(Args),
+    Vs = make_vars(IcodeArity),
+    Vs1 = make_vars(IcodeArity),    % input variable temporaries
+    Ts = make_vars(Degree),
+
+    %% Initialise environment and context.
+    Env = bind_vars(Args, Vs, env__new()),
+    %% TODO: if the function returns no values, we can use effect mode
+    Ctxt = #ctxt{final = true, effect = false},
+    %% Each basic block must begin with a label. Note that we
+    %% immediately transfer the input parameters to local variables, for
+    %% our self-recursive calling convention.
+    Start = new_label(),
+    Local = new_label(),
+    S1 = add_code([icode_label(Start)]
+		  ++ make_moves(Vs, Vs1)
+		  ++ [icode_label(Local)],
+		  s__set_function(Name, S)),
+    S2 = expr(cerl:fun_body(Fun), Ts, Ctxt, Env,
+	      s__set_local_entry({Local, Vs}, S1)),
+
+    %% This creates an Icode function definition. The ranges of used
+    %% variables and labels below should be nonempty. Note that the
+    %% input variables for the Icode function are `Vs1', which will be
+    %% transferred to `Vs' (see above).
+    HighV = new_var(),    % assure nonempty range
+    HighL = max_label(),
+    Closure = lists:member(closure, cerl:get_ann(Fun)),
+    Module = s__get_module(S2),
+    Code = s__get_code(S2),
+    Function = icode_icode(Module, Name, Vs1, Closure, Code,
+			   {LowV, HighV}, {LowL, HighL}),
+    if Closure -> 
+	    {_, OrigArity} =
+		lists:keyfind(closure_orig_arity, 1, cerl:get_ann(Fun)),
+	    {hipe_icode:icode_closure_arity_update(Function, 
+						   OrigArity), 
+	     S2};
+       true -> {Function, S2}
+    end.
+
+%% ---------------------------------------------------------------------
+%% Main expression handler
+
+expr(E, Ts, Ctxt, Env, S0) ->
+    %% Insert source code position information
+    case get_line(cerl:get_ann(E)) of
+	none ->
+	    expr_1(E, Ts, Ctxt, Env, S0);
+	Line when Line > Ctxt#ctxt.line ->
+	    Txt = "Line: " ++ integer_to_list(Line),
+	    S1 = add_code([icode_comment(Txt)], S0),
+	    expr_1(E, Ts, Ctxt#ctxt{line = Line}, Env, S1);
+	_ ->
+	    expr_1(E, Ts, Ctxt, Env, S0)
+    end.
+
+expr_1(E, Ts, Ctxt, Env, S) ->
+    case cerl:type(E) of
+	var ->
+	    expr_var(E, Ts, Ctxt, Env, S);
+	literal ->
+	    expr_literal(E, Ts, Ctxt, S);
+	values ->
+	    expr_values(E, Ts, Ctxt, Env, S);
+	tuple ->
+	    %% (The unit tuple `{}' is a literal, handled above.)
+	    expr_tuple(E, Ts, Ctxt, Env, S);
+	cons ->
+	    expr_cons(E, Ts, Ctxt, Env, S);
+	'let' ->
+	    expr_let(E, Ts, Ctxt, Env, S);
+	seq ->
+	    expr_seq(E, Ts, Ctxt, Env, S);
+	apply ->
+	    expr_apply(E, Ts, Ctxt, Env, S);
+	call ->
+	    expr_call(E, Ts, Ctxt, Env, S);
+	primop ->
+	    expr_primop(E, Ts, Ctxt, Env, S);
+	'case' ->
+	    expr_case(E, Ts, Ctxt, Env, S);
+	'receive' ->
+	    expr_receive(E, Ts, Ctxt, Env, S);
+	'try' ->
+	    expr_try(E, Ts, Ctxt, Env, S);
+	binary ->
+	    expr_binary(E, Ts, Ctxt, Env, S);
+	letrec ->
+	    expr_letrec(E, Ts, Ctxt, Env, S);
+	'fun' ->
+	    error_msg("cannot handle fun-valued expressions; "
+		      "must be closure converted."),
+	    throw(error)
+    end.
+
+%% This is for when we need new target variables for all of the
+%% expressions in the list, and evaluate them for value in a
+%% non-tail-call context.
+
+expr_list(Es, Ctxt, Env, S) ->
+    Ctxt1 = Ctxt#ctxt{effect = false, final = false},
+    lists:mapfoldl(fun (E0, S0) ->
+			   V = make_var(),
+			   {V, expr(E0, [V], Ctxt1, Env, S0)}
+		   end,
+		   S, Es).
+
+%% This is for when we already have the target variables. It is expected
+%% that each expression in the list has degree one, so the result can be
+%% assigned to the corresponding variable.
+
+exprs([E | Es], [V | Vs], Ctxt, Env, S) ->
+    S1 = expr(E, [V], Ctxt, Env, S),
+    exprs(Es, Vs, Ctxt, Env, S1);
+exprs([], [], _Ctxt, _Env, S) ->
+    S;
+exprs([], _, _Ctxt, _Env, S) ->
+    warning_low_degree(),
+    S;
+exprs(_, [], _Ctxt, _Env, _S) ->
+    error_high_degree(),
+    throw(error).
+
+get_line([L | _As]) when is_integer(L) ->
+    L;
+get_line([_ | As]) ->
+    get_line(As);
+get_line([]) ->
+    none.
+
+
+%% ---------------------------------------------------------------------
+%% Variables
+
+expr_var(_E, _Ts, #ctxt{effect = true}, _Env, S) ->
+    S;
+expr_var(E, Ts, Ctxt, Env, S) ->
+    Name = cerl:var_name(E),
+    case env__lookup(Name, Env) of
+	error ->
+	    %% Either an undefined variable or an attempt to use a local
+	    %% function name as a value.
+	    case Name of
+		{N,A} when is_atom(N), is_integer(A) ->
+		    %% error_fun_value(Name);
+		    error_msg("cannot handle fun-values outside call context; "
+			      "must be closure converted: ~P.",
+			      [Name, 5]),
+		    throw(error);
+		_ ->
+		    error_msg("undefined variable: ~P.", [Name, 5]),
+		    throw(error)
+	    end;
+	{ok, #cerl_to_icode__var{name = V}} ->
+	    case Ctxt#ctxt.final of
+		false ->
+		    glue([V], Ts, S);
+		true ->
+		    add_return([V], S)
+	    end;
+	{ok, #'fun'{}} ->
+	    %% A letrec-defined function name, used as a value.
+	    %% error_fun_value(Name)
+	    error_msg("cannot handle fun-values outside call context; "
+		      "must be closure converted: ~P.",
+		      [Name, 5]),
+	    throw(error)
+    end.
+
+%% The function has been inlined manually above to suppress message by Dialyzer
+%% error_fun_value(Name) ->
+%%    error_msg("cannot handle fun-values outside call context; "
+%%	      "must be closure converted: ~P.",
+%%	      [Name, 5]),
+%%    throw(error).
+
+%% ---------------------------------------------------------------------
+%% This handles all constants, both atomic and compound:
+
+expr_literal(_E, _Ts, #ctxt{effect = true}, S) ->
+    S;
+expr_literal(E, [V] = Ts, Ctxt, S) ->
+    Code = [icode_move(V, icode_const(cerl:concrete(E)))],
+    maybe_return(Ts, Ctxt, add_code(Code, S));
+expr_literal(E, Ts, _Ctxt, _S) ->
+    error_degree_mismatch(length(Ts), E),
+    throw(error).
+
+%% ---------------------------------------------------------------------
+%% Multiple value aggregate <X1,...,Xn>
+
+expr_values(E, Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+    {_, S1} = exprs(cerl:values_es(E), Ts, Ctxt#ctxt{final = false},
+		    Env, S),
+    S1;
+expr_values(E, Ts, Ctxt, Env, S) ->
+    S1 = exprs(cerl:values_es(E), Ts, Ctxt#ctxt{final = false}, Env, S),
+    maybe_return(Ts, Ctxt, S1).
+
+%% ---------------------------------------------------------------------
+%% Nonconstant tuples
+
+expr_tuple(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+    {_Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
+    S1;
+expr_tuple(E, [_V] = Ts, Ctxt, Env, S) ->
+    {Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
+    add_code(make_op(?OP_TUPLE, Ts, Vs, Ctxt), S1);
+expr_tuple(E, Ts, _Ctxt, _Env, _S) ->
+    error_degree_mismatch(length(Ts), E),
+    throw(error).
+
+%% ---------------------------------------------------------------------
+%% Nonconstant cons cells
+
+expr_cons(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
+    {_Vs, S1} = expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S),
+    S1;
+expr_cons(E, [_V] = Ts, Ctxt, Env, S) ->
+    {Vs, S1} = expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S),
+    add_code(make_op(?OP_CONS, Ts, Vs, Ctxt), S1);
+expr_cons(E, Ts, _Ctxt, _Env, _S) ->
+    error_degree_mismatch(length(Ts), E),
+    throw(error).
+
+%% ---------------------------------------------------------------------
+%% Let-expressions
+
+%% We want to make sure we are not easily tricked by expressions hidden
+%% in contexts like "let X = Expr in X"; this should not destroy tail
+%% call properties.
+
+expr_let(E, Ts, Ctxt, Env, S) ->
+    F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+    expr_let_1(E, F, Ctxt, Env, S).
+
+expr_let_1(E, F, Ctxt, Env, S) ->
+    E1 = cerl_lib:reduce_expr(E),
+    case cerl:is_c_let(E1) of
+	true ->
+	    expr_let_2(E1, F, Ctxt, Env, S);
+	false ->
+	    %% Redispatch the new expression.
+	    F(E1, Ctxt, Env, S)
+    end.
+
+expr_let_2(E, F, Ctxt, Env, S) ->
+    Vars = cerl:let_vars(E),
+    Vs = make_vars(length(Vars)),
+    S1 = expr(cerl:let_arg(E), Vs,
+	      Ctxt#ctxt{effect = false, final = false}, Env, S),
+    Env1 = bind_vars(Vars, Vs, Env),
+    F(cerl:let_body(E), Ctxt, Env1, S1).
+
+%% ---------------------------------------------------------------------
+%% Sequencing
+
+%% To compile a sequencing operator, we generate code for effect only
+%% for the first expression (the "argument") and then use the
+%% surrounding context for the second expression (the "body"). Note that
+%% we always create a new dummy target variable; this is necessary for
+%% many ICode operations, even if the result is not used.
+
+expr_seq(E, Ts, Ctxt, Env, S) ->
+    F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+    expr_seq_1(E, F, Ctxt, Env, S).
+
+expr_seq_1(E, F, Ctxt, Env, S) ->
+    Ctxt1 = Ctxt#ctxt{effect = true, final = false},
+    S1 = expr(cerl:seq_arg(E), [make_var()], Ctxt1, Env, S),
+    F(cerl:seq_body(E), Ctxt, Env, S1).
+
+%% ---------------------------------------------------------------------
+%% Binaries
+
+-record(sz_var,   {code, sz}).
+-record(sz_const, {code, sz}).
+
+expr_binary(E, [V]=Ts, Ctxt, Env, S) ->
+    Offset = make_reg(),
+    Base = make_reg(),
+    Segs = cerl:binary_segments(E),
+    S1 = case do_size_code(Segs, S, Env, Ctxt) of
+	     #sz_const{code = S0, sz = Size} ->
+		 Primop = {hipe_bs_primop, {bs_init, Size, 0}},
+		 add_code([icode_call_primop([V, Base, Offset], Primop, [])],
+			  S0);
+	     #sz_var{code = S0, sz = SizeVar} ->
+		 Primop = {hipe_bs_primop, {bs_init, 0}},
+		 add_code([icode_call_primop([V, Base, Offset],
+					     Primop, [SizeVar])],
+			  S0)
+	 end,
+    Vars = make_vars(length(Segs)),
+    S2 = binary_segments(Segs, Vars, Ctxt, Env, S1, false, Base, Offset),
+    S3 = case s__get_bitlevel_binaries(S2) of
+	     true ->
+		 POp = {hipe_bs_primop, bs_final},
+		 add_code([icode_call_primop([V], POp, [V, Offset])], S2);
+	     false ->
+		 S2
+	 end,
+    maybe_return(Ts, Ctxt, S3).
+
+do_size_code(Segs, S, Env, Ctxt) ->
+    case do_size_code(Segs, S, Env, cerl:c_int(0), [], []) of
+	{[], [], Const, S1} ->
+	    #sz_const{code = S1, sz = ((cerl:concrete(Const) + 7) div 8)};
+	{Pairs, Bins, Const, S1} ->
+	    V1 = make_var(),
+	    S2 = add_code([icode_move(V1, icode_const(cerl:int_val(Const)))], S1),
+	    {S3, SizeVar} = create_size_code(Pairs, Bins, Ctxt, V1, S2),
+	    #sz_var{code = S3, sz = SizeVar}
+    end.
+
+do_size_code([Seg|Rest], S, Env, Const, Pairs, Bins) ->
+    Size = cerl:bitstr_size(Seg),
+    Unit = cerl:bitstr_unit(Seg),
+    Val = cerl:bitstr_val(Seg),
+    case calculate_size(Unit, Size, false, Env, S) of
+	{all,_, _, S} ->
+	    Binary = make_var(),
+	    S1 = expr(Val, [Binary], #ctxt{final=false}, Env, S), 
+	    do_size_code(Rest, S1, Env, Const, Pairs, [{all,Binary}|Bins]);
+	{NewVal, [], S, _} ->
+	    do_size_code(Rest, S, Env, add_val(NewVal, Const), Pairs, Bins);
+	{UnitVal, [Var], S1, _} ->
+	    do_size_code(Rest, S1, Env, Const, [{UnitVal,Var}|Pairs], Bins)
+    end;
+do_size_code([], S, _Env, Const, Pairs, Bins) ->
+    {Pairs, Bins, Const, S}.
+
+add_val(NewVal, Const) ->
+    cerl:c_int(NewVal + cerl:concrete(Const)).
+
+create_size_code([{UnitVal, Var}|Rest], Bins, Ctxt, Old, S0) ->
+    Dst = make_var(),
+    S = make_bs_add(UnitVal, Old, Var, Dst, Ctxt, S0),
+    create_size_code(Rest, Bins, Ctxt, Dst, S);
+create_size_code([], Bins, Ctxt, Old, S0) -> 
+    Dst = make_var(),
+    S = make_bs_bits_to_bytes(Old, Dst, Ctxt, S0),
+    create_size_code(Bins, Ctxt, Dst, S).
+
+create_size_code([{all,Bin}|Rest], Ctxt, Old, S0) ->
+    Dst = make_var(),
+    S = make_binary_size(Old, Bin, Dst, Ctxt, S0),
+    create_size_code(Rest, Ctxt, Dst, S);
+create_size_code([], _Ctxt, Dst, S) ->
+    {S, Dst}.
+
+make_bs_add(Unit, Old, Var, Dst, #ctxt{fail=FL, class=guard}, S0) ->
+    SL1 = new_label(),
+    SL2 = new_label(),
+    SL3 = new_label(),
+    Temp = make_var(),
+    add_code([icode_if('>=', [Var, icode_const(0)], SL1, FL),
+	      icode_label(SL1),
+	      icode_guardop([Temp], '*', [Var, icode_const(Unit)], SL2, FL),
+	      icode_label(SL2),
+	      icode_guardop([Dst], '+', [Temp, Old], SL3, FL),
+	      icode_label(SL3)], S0);
+make_bs_add(Unit, Old, Var, Dst, _Ctxt, S0) ->
+    SL = new_label(),
+    FL = new_label(),
+    Temp = make_var(),
+    add_code([icode_if('>=', [Var, icode_const(0)], SL, FL),
+	      icode_label(FL),
+	      icode_fail([icode_const(badarg)], error),
+	      icode_label(SL),
+	      icode_call_primop([Temp], '*', [Var, icode_const(Unit)]),
+	      icode_call_primop([Dst], '+', [Temp, Old])], S0).
+
+make_bs_bits_to_bytes(Old, Dst, #ctxt{fail=FL, class=guard}, S0) -> 
+    SL = new_label(),
+    add_code([icode_guardop([Dst], 'bsl', [Old, icode_const(3)], SL, FL),
+	      icode_label(SL)], S0);
+make_bs_bits_to_bytes(Old, Dst, _Ctxt, S0) ->
+    add_code([icode_call_primop([Dst], 'bsl', [Old, icode_const(3)])], S0).
+
+make_binary_size(Old, Bin, Dst, #ctxt{fail=FL, class=guard}, S0) -> 
+    SL1 = new_label(),
+    SL2 = new_label(),
+    add_code([icode_guardop([Dst], {erlang, byte_size, 1}, [Bin], SL1, FL),
+	      icode_label(SL1),
+	      icode_guardop([Dst], '+', [Old, Dst], SL2, FL),
+	      icode_label(SL2)], S0);
+make_binary_size(Old, Bin, Dst, _Ctxt, S0) ->
+    add_code([icode_call_primop([Dst], {erlang, byte_size, 1}, [Bin]),
+	      icode_call_primop([Dst], '+', [Old, Dst])], S0).
+
+binary_segments(SegList, TList, Ctxt=#ctxt{}, Env, S, Align, Base,
+		Offset) ->
+    case do_const_segs(SegList, TList, S, Align, Base, Offset) of
+	{[Seg|Rest], [T|Ts], S1} ->
+	    {S2, NewAlign} = bitstr(Seg, [T], Ctxt, Env, S1, Align,
+				    Base, Offset),
+	    binary_segments(Rest, Ts, Ctxt, Env, S2, NewAlign, Base, Offset);
+	{[], [], S1} ->
+	    S1
+    end.
+
+do_const_segs(SegList, TList, S, _Align, Base, Offset) ->
+    case get_segs(SegList, TList, [], 0, {[], SegList, TList}) of
+	{[], SegList, TList} ->
+	    {SegList, TList, S};
+	{ConstSegs, RestSegs, RestT} ->
+	    String = create_string(ConstSegs, <<>>, 0),
+	    Name = {bs_put_string, String, length(String)},
+	    Primop = {hipe_bs_primop, Name},
+	    {RestSegs, RestT,
+	     add_code([icode_call_primop([Offset], Primop, [Base, Offset])],
+		      S)}
+    end.
+	     
+get_segs([Seg|Rest], [_|RestT], Acc, AccSize, BestPresent) ->
+    Size = cerl:bitstr_size(Seg),
+    Unit = cerl:bitstr_unit(Seg),
+    Val = cerl:bitstr_val(Seg),
+    case allowed(Size, Unit, Val, AccSize) of
+	{true, NewAccSize} ->
+	    case Acc of
+		[] ->
+		    get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
+		_ ->
+		    get_segs(Rest, RestT, [Seg|Acc], NewAccSize, 
+			     {lists:reverse([Seg|Acc]), Rest, RestT})
+	    end;
+	{possible, NewAccSize} ->
+	    get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
+	false ->
+	    BestPresent
+    end;
+get_segs([], [], _Acc, _AccSize, Best) ->
+    Best.
+
+		
+create_string([Seg|Rest], Bin, TotalSize) ->
+    Size = cerl:bitstr_size(Seg),
+    Unit = cerl:bitstr_unit(Seg), 
+    NewSize = cerl:int_val(Size) * cerl:int_val(Unit),
+    LitVal = cerl:concrete(cerl:bitstr_val(Seg)),
+    LiteralFlags = cerl:bitstr_flags(Seg),
+    FlagVal = translate_flags(LiteralFlags, []),
+    NewTotalSize = NewSize + TotalSize,
+    Pad = (8 - NewTotalSize rem 8) rem 8,
+    NewBin = case cerl:concrete(cerl:bitstr_type(Seg)) of
+		 integer ->
+		     case {FlagVal band 2, FlagVal band 4} of
+			 {2, 4} ->
+			     <<Bin:TotalSize/binary-unit:1, 
+			      LitVal:NewSize/integer-little-signed, 0:Pad>>;
+			 {0, 4} ->
+			     <<Bin:TotalSize/binary-unit:1, 
+			      LitVal:NewSize/integer-signed, 0:Pad>>;
+			 {2, 0} ->
+			     <<Bin:TotalSize/binary-unit:1, 
+			      LitVal:NewSize/integer-little, 0:Pad>>;
+			 {0, 0} ->
+			     <<Bin:TotalSize/binary-unit:1, 
+			      LitVal:NewSize/integer, 0:Pad>>
+		     end;
+		 float ->
+		     case FlagVal band 2 of
+			 2 ->
+			     <<Bin:TotalSize/binary-unit:1,
+			      LitVal:NewSize/float-little, 0:Pad>>;
+			 0 ->
+			     <<Bin:TotalSize/binary-unit:1,
+			      LitVal:NewSize/float, 0:Pad>>
+		     end
+	     end,
+    create_string(Rest, NewBin, NewTotalSize);
+
+create_string([], Bin, _Size) ->
+    binary_to_list(Bin).
+		
+allowed(Size, Unit, Val, AccSize) ->
+    case {cerl:is_c_int(Size), cerl:is_literal(Val)} of
+	{true, true} ->
+	    NewAccSize = cerl:int_val(Size) * cerl:int_val(Unit) + AccSize,
+	    case NewAccSize rem 8 of
+		0 ->
+		    {true, NewAccSize};
+		_ ->
+		    {possible, NewAccSize}
+	    end;
+	_ ->
+	    false
+    end.
+
+bitstr(E, Ts, Ctxt, Env, S, Align, Base, Offset) ->
+    Size = cerl:bitstr_size(E),
+    Unit = cerl:bitstr_unit(E),
+    LiteralFlags = cerl:bitstr_flags(E),
+    Val = cerl:bitstr_val(E),
+    Type = cerl:concrete(cerl:bitstr_type(E)),
+    S0 = expr(Val, Ts, Ctxt#ctxt{final = false, effect = false}, Env, S),
+    ConstInfo = get_const_info(Val, Type),
+    Flags = translate_flags(LiteralFlags, Align),
+    SizeInfo = calculate_size(Unit, Size, false, Env, S0),
+    bitstr_gen_op(Ts, Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset).
+
+bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo,
+	      Type, Flags, Base, Offset) ->
+    SL = new_label(),
+    case SizeInfo of
+	{all,_NewUnit, NewAlign, S1} ->
+	    Type = binary,
+	    Name = {bs_put_binary_all, Flags},
+	    Primop = {hipe_bs_primop, Name},
+	    {add_code([icode_guardop([Offset], Primop,
+				     [V, Base, Offset], SL, FL),
+		       icode_label(SL)], S1), NewAlign};
+	{NewUnit, NewArgs, S1, NewAlign} ->
+	    Args = [V|NewArgs] ++ [Base, Offset],
+	    Name =
+		case Type of
+		    integer ->
+			{bs_put_integer, NewUnit, Flags, ConstInfo};
+		    float ->
+			{bs_put_float, NewUnit, Flags, ConstInfo};
+		    binary ->
+			{bs_put_binary, NewUnit, Flags}
+		end,
+	    Primop = {hipe_bs_primop, Name},
+	    {add_code([icode_guardop([Offset], Primop, Args, SL, FL),
+		       icode_label(SL)], S1), NewAlign}
+    end;
+bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base,
+	      Offset) ->
+    case SizeInfo of
+	{all, _NewUnit, NewAlign, S} ->
+	    Type = binary,
+	    Name = {bs_put_binary_all, Flags},
+	    Primop = {hipe_bs_primop, Name},
+	    {add_code([icode_call_primop([Offset], Primop, 
+					 [V, Base, Offset])], S), 
+	     NewAlign};
+	{NewUnit, NewArgs, S, NewAlign} ->
+	    Args = [V|NewArgs] ++ [Base, Offset],
+	    Name =
+		case Type of
+		    integer ->
+			{bs_put_integer, NewUnit, Flags, ConstInfo};
+		    float ->
+			{bs_put_float, NewUnit, Flags, ConstInfo};
+		    binary ->
+			{bs_put_binary, NewUnit, Flags}
+		end,
+	    Primop = {hipe_bs_primop, Name},
+	    {add_code([icode_call_primop([Offset], Primop, Args)], S), 
+	     NewAlign}
+    end.
+
+%% ---------------------------------------------------------------------
+%% Apply-expressions
+
+%% Note that the arity of the called function only depends on the length
+%% of the argument list; the arity stated by the function name is
+%% ignored.
+
+expr_apply(E, Ts, Ctxt, Env, S) ->
+    Op = cerl_lib:reduce_expr(cerl:apply_op(E)),
+    {Vs, S1} = expr_list(cerl:apply_args(E), Ctxt, Env, S),
+    case cerl:is_c_var(Op) of
+	true ->
+	    case cerl:var_name(Op) of
+		{N, A} = V when is_atom(N), is_integer(A) ->
+		    case env__lookup(V, Env) of
+			error ->
+			    %% Assumed to be a function in the
+			    %% current module; we don't check.
+			    add_local_call(V, Vs, Ts, Ctxt, S1);
+			{ok, #'fun'{label = L, vars = Vs1}} ->
+			    %% Call to a local letrec-bound function.
+			    add_letrec_call(L, Vs1, Vs, Ctxt, S1);
+			{ok, #cerl_to_icode__var{}} ->
+			    error_msg("cannot call via variable; must "
+				      "be closure converted: ~P.",
+				      [V, 5]),
+			    throw(error)
+		    end;
+		_ ->
+		    error_nonlocal_application(Op),
+		    throw(error)
+	    end;
+	false ->
+	    error_nonlocal_application(Op),
+	    throw(error)
+    end.
+
+%% ---------------------------------------------------------------------
+%% Call-expressions
+
+%% Unless we know the module and function names statically, we have to
+%% go through the meta-call operator for a static number of arguments.
+
+expr_call(E, Ts, Ctxt, Env, S) ->
+    Module = cerl_lib:reduce_expr(cerl:call_module(E)),
+    Name = cerl_lib:reduce_expr(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),
+	    {Vs, S1} = expr_list(cerl:call_args(E), Ctxt, Env, S),
+	    add_code(make_call(M, F, Ts, Vs, Ctxt), S1);
+	false ->
+	    Args = cerl:call_args(E),
+	    N = length(Args),
+	    {Vs, S1} = expr_list([Module, Name | Args], Ctxt, Env, S),
+	    add_code(make_op(?OP_APPLY_FIXARITY(N), Ts, Vs, Ctxt), S1)
+    end.
+
+%% ---------------------------------------------------------------------
+%% Primop calls
+
+%% Core Erlang primop calls are generally mapped directly to Icode
+%% primop calls, with a few exceptions (listed above), which are
+%% expanded inline, sometimes depending on context. Note that primop
+%% calls do not have specialized tail-call forms.
+
+expr_primop(E, Ts, Ctxt, Env, S) ->
+    Name = cerl:atom_val(cerl:primop_name(E)),
+    As = cerl:primop_args(E),
+    Arity = length(As),
+    expr_primop_0(Name, Arity, As, E, Ts, Ctxt, Env, S).
+
+expr_primop_0(Name, Arity, As, E, Ts, #ctxt{effect = true} = Ctxt, Env,
+	      S) ->
+    case is_safe_op(Name, Arity) of
+	true ->
+	    %% Just drop the operation; cf. 'expr_values(...)'.
+	    {_, S1} = expr_list(As, Ctxt, Env, S),
+	    S1;
+	false ->
+	    expr_primop_1(Name, Arity, As, E, Ts,
+			  Ctxt#ctxt{effect = false}, Env, S)
+    end;
+expr_primop_0(Name, Arity, As, E, Ts, Ctxt, Env, S) ->
+    expr_primop_1(Name, Arity, As, E, Ts, Ctxt, Env, S).
+
+%% Some primops must be caught before their arguments are visited.
+
+expr_primop_1(?PRIMOP_MAKE_FUN, 6, As, _E, Ts, Ctxt, Env, S) ->
+    primop_make_fun(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_APPLY_FUN, 2, As, _E, Ts, Ctxt, Env, S) ->
+    primop_apply_fun(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_FUN_ELEMENT, 2, As, _E, Ts, Ctxt, Env, S) ->
+    primop_fun_element(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_DSETELEMENT, 3, As, _E, Ts, Ctxt, Env, S) ->
+    primop_dsetelement(As, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_RECEIVE_SELECT, 0, _As, _E, Ts, Ctxt, _Env, S) ->
+    primop_receive_select(Ts, Ctxt, S);
+expr_primop_1(?PRIMOP_RECEIVE_NEXT, 0, _As, _E, _Ts, Ctxt, _Env, S) ->
+    primop_receive_next(Ctxt, S);
+%%expr_primop_1(?PRIMOP_IDENTITY, 1, [A], _E, Ts, Ctxt, Env, S) ->
+%%    expr(A, Ts, Ctxt, Env, S);  % used for unary plus
+expr_primop_1(?PRIMOP_NEG, 1, [A], _, Ts, Ctxt, Env, S) ->
+    E = cerl:c_primop(cerl:c_atom('-'), [cerl:c_int(0), A]),
+    expr_primop(E, Ts, Ctxt, Env, S);
+expr_primop_1(?PRIMOP_GOTO_LABEL, 1, [A], _, _Ts, _Ctxt, _Env, S) ->
+    primop_goto_label(A, S);
+expr_primop_1(?PRIMOP_REDUCTION_TEST, 0, [], _, _Ts, Ctxt, _Env, S) ->
+    primop_reduction_test(Ctxt, S);
+expr_primop_1(Name, Arity, As, E, Ts, Ctxt, Env, S) ->
+    case is_pure_op_aux(Name, Arity) of
+	true ->
+	    boolean_expr(E, Ts, Ctxt, Env, S);
+	false ->
+	    {Vs, S1} = expr_list(As, Ctxt, Env, S),
+	    expr_primop_2(Name, Arity, Vs, Ts, Ctxt, S1)
+    end.
+
+expr_primop_2(?PRIMOP_ELEMENT, 2, Vs, Ts, Ctxt, S) ->
+    add_code(make_op(?OP_ELEMENT, Ts, Vs, Ctxt), S);
+expr_primop_2(?PRIMOP_BS_CONTEXT_TO_BINARY, 1, Vs, Ts, Ctxt, S) ->
+    add_code(make_op(?OP_BS_CONTEXT_TO_BINARY, Ts, Vs, Ctxt), S);
+expr_primop_2(?PRIMOP_EXIT, 1, [V], _Ts, Ctxt, S) ->
+    add_exit(V, Ctxt, S);
+expr_primop_2(?PRIMOP_THROW, 1, [V], _Ts, Ctxt, S) ->
+    add_throw(V, Ctxt, S);
+expr_primop_2(?PRIMOP_ERROR, 1, [V], _Ts, Ctxt, S) ->
+    add_error(V, Ctxt, S);
+expr_primop_2(?PRIMOP_ERROR, 2, [V, F], _Ts, Ctxt, S) ->
+    add_error(V, F, Ctxt, S);
+expr_primop_2(?PRIMOP_RETHROW, 2, [E, V], _Ts, Ctxt, S) ->
+    add_rethrow(E, V, Ctxt, S);
+expr_primop_2(Name, _Arity, Vs, Ts, Ctxt, S) ->
+    %% Other ops are assumed to be recognized by the backend.
+    add_code(make_op(Name, Ts, Vs, Ctxt), S).
+
+%% All of M, F, and A must be literals with the right types.
+%% V must represent a proper list.
+
+primop_make_fun([M, F, A, H, I, V] = As, [_T] = Ts, Ctxt, Env, S) ->
+    case cerl:is_c_atom(M) and
+	cerl:is_c_atom(F) and
+	cerl:is_c_int(A) and
+	cerl:is_c_int(H) and
+	cerl:is_c_int(I) and
+	cerl:is_c_list(V) of
+	true ->
+	    Module = cerl:atom_val(M),
+	    Name = cerl:atom_val(F),
+	    Arity = cerl:int_val(A),
+	    Hash = cerl:int_val(H),
+	    Index = cerl:int_val(I),
+	    {Vs, S1} = expr_list(cerl:list_elements(V),
+				 Ctxt, Env, S),
+ 	    add_code(make_op(?OP_MAKE_FUN(Module, Name, Arity,
+					  Hash, Index),
+			     Ts, Vs, Ctxt),
+		     S1);
+	false ->
+	    error_primop_badargs(?PRIMOP_MAKE_FUN, As),
+	    throw(error)
+    end.
+
+%% V must represent a proper list.
+
+primop_apply_fun([F, V] = As, [_T] = Ts, Ctxt, Env, S) ->
+    case cerl:is_c_list(V) of
+	true ->
+	    %% Note that the closure itself is passed as the last value.
+	    {Vs, S1} = expr_list(cerl:list_elements(V) ++ [F],
+				 Ctxt, Env, S),
+	    case Ctxt#ctxt.final of
+		false ->
+		    add_code([icode_call_fun(Ts, Vs)], S1);
+		true ->
+		    add_code([icode_enter_fun(Vs)], S1)
+	    end;
+	false ->
+	    error_primop_badargs(?PRIMOP_APPLY_FUN, As),
+	    throw(error)
+    end.
+
+primop_fun_element([N, F] = As, Ts, Ctxt, Env, S) ->
+    case cerl:is_c_int(N) of
+	true ->
+	    V = make_var(),
+	    S1 = expr(F, [V], Ctxt#ctxt{final = false, effect = false},
+		      Env, S),
+	    add_code(make_op(?OP_FUN_ELEMENT(cerl:int_val(N)),
+			     Ts, [V], Ctxt),
+		     S1);
+	false ->
+	    error_primop_badargs(?PRIMOP_FUN_ELEMENT, As),
+	    throw(error)
+    end.
+
+primop_goto_label(A, S) ->
+    {Label,S1} = s__get_label(A, S),
+    add_code([icode_goto(Label)], S1).
+
+is_goto(E) ->
+    case cerl:type(E) of 
+	primop ->
+	    Name = cerl:atom_val(cerl:primop_name(E)),
+	    As = cerl:primop_args(E),
+	    Arity = length(As),
+	    case {Name, Arity} of
+		{?PRIMOP_GOTO_LABEL, 1} ->
+		    true;
+		_ ->
+		    false
+	    end;
+	_ ->
+	    false
+    end.
+		       
+primop_reduction_test(Ctxt, S) ->
+    add_code(make_op(?OP_REDTEST, [], [], Ctxt), S).
+
+primop_dsetelement([N | As1] = As, Ts, Ctxt, Env, S) ->
+    case cerl:is_c_int(N) of
+	true ->
+	    {Vs, S1} = expr_list(As1, Ctxt, Env, S),
+	    add_code(make_op(?OP_UNSAFE_SETELEMENT(cerl:int_val(N)),
+			     Ts, Vs, Ctxt),
+		     S1);
+	false ->
+	    error_primop_badargs(?PRIMOP_DSETELEMENT, As),
+	    throw(error)
+    end.
+
+%% ---------------------------------------------------------------------
+%% Try-expressions:
+
+%% We want to rewrite trivial things like `try A of X -> B catch ...',
+%% where A is safe, into a simple let-binding `let X = A in B', avoiding
+%% unnecessary try-blocks. (The `let' might become further simplified.)
+
+expr_try(E, Ts, Ctxt, Env, S) ->
+    F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+    expr_try_1(E, F, Ctxt, Env, S).
+
+expr_try_1(E, F, Ctxt, Env, S) ->
+    A = cerl:try_arg(E),
+    case is_safe_expr(A) of
+	true ->
+	    E1 = cerl:c_let(cerl:try_vars(E), A, cerl:try_body(E)),
+	    expr_let_1(E1, F, Ctxt, Env, S);
+	false ->
+	    expr_try_2(E, F, Ctxt, Env, S)
+    end.
+
+%% TODO: maybe skip begin_try/end_try and just use fail-labels...
+
+expr_try_2(E, F, Ctxt, Env, S) ->
+    Cont = new_continuation_label(Ctxt),
+    Catch = new_label(),
+    Next = new_label(),
+    S1 = add_code([icode_begin_try(Catch,Next),icode_label(Next)], S),
+    Vars = cerl:try_vars(E),
+    Vs = make_vars(length(Vars)),
+    Ctxt1 = Ctxt#ctxt{final = false},
+    S2 = expr(cerl:try_arg(E), Vs, Ctxt1, Env, S1),
+    Env1 = bind_vars(Vars, Vs, Env),
+    S3 = add_code([icode_end_try()], S2),
+    S4 = F(cerl:try_body(E), Ctxt, Env1, S3),
+    S5 = add_continuation_jump(Cont, Ctxt, S4),
+    EVars = cerl:try_evars(E),
+    EVs = make_vars(length(EVars)),
+    Env2 = bind_vars(EVars, EVs, Env),
+    S6 = add_code([icode_label(Catch), icode_begin_handler(EVs)], S5),
+    S7 = F(cerl:try_handler(E), Ctxt, Env2, S6),
+    add_continuation_label(Cont, Ctxt, S7).
+
+%% ---------------------------------------------------------------------
+%% Letrec-expressions (local goto-labels)
+
+%% We only handle letrec-functions as continuations. The fun-bodies are
+%% always compiled in the same context as the main letrec-body. Note
+%% that we cannot propagate "advanced" contexts like boolean-compilation
+%% into the letrec body like we do for ordinary lets or seqs, since the
+%% context for an individual local function would be depending on the
+%% contexts of its call sites.
+
+expr_letrec(E, Ts, Ctxt, Env, S) ->
+    Ds = cerl:letrec_defs(E),
+    Env1 = add_defs(Ds, Env),
+    S1 = expr(cerl:letrec_body(E), Ts, Ctxt, Env1, S),
+    Next = new_continuation_label(Ctxt),
+    S2 = add_continuation_jump(Next, Ctxt, S1),
+    S3 = defs(Ds, Ts, Ctxt, Env1, S2),
+    add_continuation_label(Next, Ctxt, S3).
+
+add_defs([{V, _F} | Ds], Env) ->
+    {_, A} = cerl:var_name(V),
+    Vs = make_vars(A),
+    L = new_label(),
+    Env1 = bind_fun(V, L, Vs, Env),
+    add_defs(Ds, Env1);
+add_defs([], Env) ->
+    Env.
+
+defs([{V, F} | Ds], Ts, Ctxt, Env, S) ->
+    Name = cerl:var_name(V),
+    #'fun'{label = L, vars = Vs} = env__get(Name, Env),
+    S1 = add_code([icode_label(L)], S),
+    Env1 = bind_vars(cerl:fun_vars(F), Vs, Env),
+    S2 = expr(cerl:fun_body(F), Ts, Ctxt, Env1, S1),
+    defs(Ds, Ts, Ctxt, Env, S2);
+defs([], _Ts, _Ctxt, _Env, S) ->
+    S.
+
+%% ---------------------------------------------------------------------
+%% Receive-expressions
+
+%% There may only be exactly one clause, which must be a trivial
+%% catch-all with exactly one (variable) pattern. Each message will be
+%% read from the mailbox and bound to the pattern variable; the body of
+%% the clause must do the switching and call either of the primops
+%% `receive_select/0' or `receive_next/0'.
+
+expr_receive(E, Ts, Ctxt, Env, S) ->
+    F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+    expr_receive_1(E, F, Ctxt, Env, S).
+
+expr_receive_1(E, F, Ctxt, Env, S) ->
+    case cerl:receive_clauses(E) of
+	[C] ->
+	    case cerl:clause_pats(C) of
+		[_] ->
+		    case cerl_clauses:is_catchall(C) of
+			true ->
+			    expr_receive_2(C, E, F, Ctxt, Env, S);
+			false ->
+			    error_msg("receive-expression clause "
+				      "must be a catch-all."),
+			    throw(error)
+		    end;
+		_ ->
+		    error_msg("receive-expression clause must "
+			      "have exactly one pattern."),
+		    throw(error)
+	    end;
+	_ ->
+	    error_msg("receive-expressions must have "
+		      "exactly one clause."),
+	    throw(error)
+    end.
+
+%% There are a number of primitives to do the work involved in receiving
+%% messages:
+%%
+%%	if-tests:	suspend_msg_timeout()
+%%
+%%	primops:	V = check_get_msg()
+%%			select_msg()
+%%			next_msg()
+%%			set_timeout(T)
+%%			clear_timeout()
+%%			suspend_msg()
+%%
+%% `check_get_msg' tests if the mailbox is empty or not, and if not it
+%% reads the message currently pointed to by the implicit message pointer.
+%% `select_msg' removes the current message from the mailbox, resets the
+%% message pointer and clears any timeout. `next_msg' advances the
+%% message pointer but does nothing else. `set_timeout(T)' sets up the
+%% timeout mechanism *unless it is already set*. `suspend_msg' suspends
+%% until a message has arrived and does not check for timeout. The test
+%% `suspend_msg_timeout' suspends the process and upon resuming
+%% execution selects the `true' branch if a message has arrived and the
+%% `false' branch otherwise. `clear_timeout' resets the message pointer
+%% when a timeout has occurred (the name is somewhat misleading).
+%%
+%% Note: the receiving of a message must be performed so that the
+%% message pointer is always reset when the receive is done; thus, all
+%% paths must go through either `select_msg' or `clear_timeout'.
+
+%% Recall that the `final' and `effect' context flags distribute over
+%% the clauses *and* the timeout action (but not over the
+%% timeout-expression, which is always executed for its value).
+
+%% This is the code we generate for a full receive:
+%%
+%%   Loop:	check_get_msg(Match, Wait)
+%%   Wait:	set_timeout
+%%		suspend_msg_timeout(Loop, Timeout)
+%%   Timeout:	clear_timeout
+%%		TIMEOUT-ACTION
+%%		goto Next
+%%   Match:     RECEIVE-CLAUSES(Loop, Next)
+%%   Next:	...
+%%
+%% For a receive with infinity timout, we generate
+%%
+%%   Wait:	suspend_msg
+%%		goto Loop
+%%
+%% For a receive with zero timout, we generate
+%%
+%%   Wait:	clear_timeout
+%%		TIMEOUT-ACTION
+%%		goto Next
+
+expr_receive_2(C, E, F, Ctxt, Env, S0) ->
+    Expiry = cerl_lib:reduce_expr(cerl:receive_timeout(E)),
+    After = case cerl:is_literal(Expiry) of
+		true ->
+		    cerl:concrete(Expiry);
+		false ->
+		    undefined
+	    end,
+    T = make_var(),    % T will hold the timeout value
+    %% It would be harmless to generate code for `infinity', but we
+    %% might as well avoid it if we can.
+    S1 = if After =:= 'infinity' -> S0;
+	    true ->
+		 expr(Expiry, [T],
+		      Ctxt#ctxt{final = false, effect = false},
+		      Env, S0)
+	 end,
+
+    %% This is the top of the receive-loop, which checks if the
+    %% mailbox is empty, and otherwise reads the next message.
+    Loop = new_label(),
+    Wait = new_label(),
+    Match = new_label(),
+    V = make_var(),
+    S2 = add_code([icode_label(Loop),
+		   icode_call_primop([V], ?OP_CHECK_GET_MESSAGE, [],
+				     Match, Wait),
+		   icode_label(Wait)], S1),
+
+    %% The wait-for-message section looks a bit different depending on
+    %% whether we actually need to set a timer or not.
+    Ctxt0 = #ctxt{},
+    S3 = case After of
+	     'infinity' ->
+		 %% Only wake up when we get new messages, and never
+		 %% execute the expiry body.
+		 add_code(make_op(?OP_WAIT_FOR_MESSAGE, [], [], Ctxt0)
+			  ++ [icode_goto(Loop)], S2);
+	     0 ->
+		 %% Zero limit - reset the message pointer (this is what
+		 %% "clear timeout" does) and execute the expiry body.
+		 add_code(make_op(?OP_CLEAR_TIMEOUT, [], [], Ctxt0),
+			  S2);
+	     _ ->
+		 %% Other value - set the timer (if it is already set,
+		 %% nothing is changed) and wait for a message or
+		 %% timeout. Reset the message pointer upon timeout.
+		 Timeout = new_label(),
+		 add_code(make_op(?OP_SET_TIMEOUT, [], [T], Ctxt0)
+			  ++ [make_if(?TEST_WAIT_FOR_MESSAGE_OR_TIMEOUT,
+				      [], Loop, Timeout),
+			      icode_label(Timeout)]
+			  ++ make_op(?OP_CLEAR_TIMEOUT, [], [], Ctxt0),
+			  S2)
+	 end,
+
+    %% We never generate code for the expiry body if the timeout value
+    %% is 'infinity' (and thus we know that it will not be used), mainly
+    %% because in this case it is possible (and legal) for the expiry
+    %% body to not have the expected degree. (Typically, it produces a
+    %% single constant value such as 'true', while the clauses may be
+    %% producing 2 or more values.)
+    Next = new_continuation_label(Ctxt),
+    S4 = if After =:= 'infinity' -> S3;
+	    true ->
+		 add_continuation_jump(Next, Ctxt,
+				       F(cerl:receive_action(E), Ctxt,
+					 Env, S3))
+	 end,
+
+    %% When we compile the primitive operations that select the current
+    %% message or loop to try the next message (see the functions
+    %% 'primop_receive_next' and 'primop_receive_select'), we will use
+    %% the receive-loop label in the context (i.e., that of the nearest
+    %% enclosing receive expression).
+    Ctxt1 = Ctxt#ctxt{'receive' = #'receive'{loop = Loop}},
+
+    %% The pattern variable of the clause will be mapped to `V', which
+    %% holds the message, so it can be accessed in the clause body:
+    S5 = clauses([C], F, [V], Ctxt1, Env,
+		 add_code([icode_label(Match)], S4)),
+    add_continuation_label(Next, Ctxt, S5).
+
+%% Primops supporting "expanded" receive-expressions on the Core level:
+
+primop_receive_next(#ctxt{'receive' = R} = Ctxt, S0) ->
+    case R of
+	#'receive'{loop = Loop} ->
+	    %% Note that this has the same "problem" as the fail
+	    %% instruction (see the 'add_fail' function), namely, that
+	    %% it unexpectedly ends a basic block. The solution is the
+	    %% same - add a dummy label if necessary.
+	    S1 = add_code(make_op(?OP_NEXT_MESSAGE, [], [], #ctxt{})
+			  ++ [icode_goto(Loop)], S0),
+	    add_new_continuation_label(Ctxt, S1);
+	_ ->
+	    error_not_in_receive(?PRIMOP_RECEIVE_NEXT),
+	    throw(error)
+    end.
+
+primop_receive_select(Ts, #ctxt{'receive' = R} = Ctxt, S) ->
+    case R of
+	#'receive'{} ->
+	    add_code(make_op(?OP_SELECT_MESSAGE, Ts, [], Ctxt), S);
+	_ ->
+	    error_not_in_receive(?PRIMOP_RECEIVE_SELECT),
+	    throw(error)
+    end.
+
+%% ---------------------------------------------------------------------
+%% Case expressions
+
+%% Typically, pattern matching compilation has split all switches into
+%% separate groups of tuples, integers, atoms, etc., where each such
+%% switch over a group of constructors is protected by a type test.
+%% Thus, it is straightforward to generate switch instructions. (If no
+%% pattern matching compilation has been done, we don't care about
+%% efficiency anyway, so we don't spend any extra effort here.)
+
+expr_case(E, Ts, Ctxt, Env, S) ->
+    F = fun (BF, CtxtF, EnvF, SF) -> expr(BF, Ts, CtxtF, EnvF, SF) end,
+    expr_case_1(E, F, Ctxt, Env, S).
+
+expr_case_1(E, F, Ctxt, Env, S) ->
+    Cs = cerl:case_clauses(E),
+    A = cerl:case_arg(E),
+    case cerl_lib:is_bool_switch(Cs) of
+	true ->
+	    %% An if-then-else with a known boolean argument
+	    {True, False} = cerl_lib:bool_switch_cases(Cs),
+	    bool_switch(A, True, False, F, Ctxt, Env, S);
+	false ->
+	    Vs = make_vars(cerl:clause_arity(hd(Cs))),
+	    Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+	    S1 = expr(A, Vs, Ctxt1, Env, S),
+	    expr_case_2(Vs, Cs, F, Ctxt, Env, S1)
+    end.
+
+%% Switching on a value
+
+expr_case_2(Vs, Cs, F, Ctxt, Env, S1) ->
+    case is_constant_switch(Cs) of
+	true ->
+	    switch_val_clauses(Cs, F, Vs, Ctxt, Env, S1);
+	false ->
+	    case is_tuple_switch(Cs) of
+		true ->
+		    switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S1);
+		false ->
+		    case is_binary_switch(Cs, S1) of
+			true ->
+			    switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S1);
+			false ->
+			    clauses(Cs, F, Vs, Ctxt, Env, S1)
+		    end
+	    end
+    end.
+
+%% Check if a list of clauses represents a switch over a number (more
+%% than 1) of constants (integers or atoms), or tuples (whose elements
+%% are all variables)
+
+is_constant_switch(Cs) ->
+    is_switch(Cs, fun (P) -> (cerl:type(P) =:= literal) andalso
+				 (is_integer(cerl:concrete(P))
+				  orelse is_atom(cerl:concrete(P))) end).
+
+is_tuple_switch(Cs) ->
+    is_switch(Cs, fun (P) -> cerl:is_c_tuple(P) andalso
+				 all_vars(cerl:tuple_es(P)) end).
+
+is_binary_switch(Cs, S) ->
+    case s__get_pmatch(S) of
+	False when False =:= false; False =:= undefined ->
+	    false;
+	Other when Other =:= duplicate_all; Other =:= no_duplicates; Other =:= true->
+	    is_binary_switch1(Cs, 0)
+    end.
+
+is_binary_switch1([C|Cs], N) ->
+    case cerl:clause_pats(C) of
+	[P] ->
+	    case cerl:is_c_binary(P) of
+		true ->
+		    is_binary_switch1(Cs, N + 1);
+		false -> 
+		    %% The final clause may be a catch-all.
+		    Cs =:= [] andalso N > 0 andalso cerl:type(P) =:= var
+	    end;
+	_ ->
+	    false
+    end;
+is_binary_switch1([], N) ->
+    N > 0.
+
+all_vars([E | Es]) ->
+    case cerl:is_c_var(E) of
+	true -> all_vars(Es);
+	false -> false
+    end;
+all_vars([]) -> true.
+
+is_switch(Cs, F) ->
+    is_switch(Cs, F, 0).
+
+is_switch([C | Cs], F, N) ->
+    case cerl_lib:is_simple_clause(C) of
+	true ->
+	    [P] = cerl:clause_pats(C),
+	    case F(P) of
+		true ->
+		    is_switch(Cs, F, N + 1);
+		false ->
+		    %% The final clause may be a catch-all.
+		    Cs =:= [] andalso N > 1 andalso cerl:type(P) =:= var
+	    end;
+	false -> false
+    end;
+is_switch([], _F, N) ->
+    N > 1.
+
+switch_val_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+    switch_clauses(Cs, F, Vs, Ctxt, Env,
+		   fun (P) -> cerl:concrete(P) end,
+		   fun icode_switch_val/4,
+		   fun val_clause_body/9,
+		   S).
+
+val_clause_body(_N, _V, C, F, Next, _Fail, Ctxt, Env, S) ->
+    clause_body(C, F, Next, Ctxt, Env, S).
+
+switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+    switch_clauses(Cs, F, Vs, Ctxt, Env, 
+		   fun (P) -> cerl:tuple_arity(P) end,
+		   fun icode_switch_tuple_arity/4,
+		   fun tuple_clause_body/9,
+		   S).
+
+tuple_clause_body(N, V, C, F, Next, Fail, Ctxt, Env, S0) ->
+    Vs = make_vars(N),
+    S1 = tuple_elements(Vs, V, S0),
+    Es = cerl:tuple_es(hd(cerl:clause_pats(C))),
+    {Env1, S2} = patterns(Es, Vs, Fail, Env, S1),
+    clause_body(C, F, Next, Ctxt, Env1, S2).
+
+switch_clauses(Cs, F, [V], Ctxt, Env, GetVal, Switch, Body, S0) ->
+    Cs1 = [switch_clause(C, GetVal) || C <- Cs],
+    Cases = [{Val, L} || {Val, L, _} <- Cs1],
+    Default = [C || {default, C} <- Cs1],
+    Fail = new_label(),
+    S1 = add_code([Switch(V, Fail, length(Cases), Cases)], S0),
+    Next = new_continuation_label(Ctxt),
+    S3 = case Default of
+	     [] -> add_default_case(Fail, Ctxt, S1);
+	     [C] ->
+		 %% Bind the catch-all variable (this always succeeds)
+		 {Env1, S2} = patterns(cerl:clause_pats(C), [V], Fail,
+				       Env, S1),
+		 clause_body(C, F, Next, Ctxt, Env1,
+			     add_code([icode_label(Fail)], S2))
+	 end,
+    S4 = switch_cases(Cs1, V, F, Next, Fail, Ctxt, Env, Body, S3),
+    add_continuation_label(Next, Ctxt, S4).
+
+switch_clause(C, F) ->
+    [P] = cerl:clause_pats(C),
+    L = new_label(),
+    case cerl:type(P) of
+	var -> {default, C};
+	_ -> {icode_const(F(P)), L, C}
+    end.
+
+switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S) ->
+    {Bins, Default} = get_binary_clauses(Cs),
+    Fail = new_label(),
+    Next = new_continuation_label(Ctxt),
+    S1 = binary_match(Bins, F, Vs, Next, Fail, Ctxt, Env, S),
+    S2 = case Default of
+	     [] -> add_default_case(Fail, Ctxt, S1);
+	     [C] ->
+		 clause_body(C, F, Next, Ctxt, Env,
+			     add_code([icode_label(Fail)], S1))
+	 end,
+    add_continuation_label(Next, Ctxt, S2).
+    
+get_binary_clauses(Cs) ->    
+    get_binary_clauses(Cs, []).
+
+get_binary_clauses([C|Cs], Acc) ->
+    [P] = cerl:clause_pats(C),
+    case cerl:is_c_binary(P) of 
+	true ->
+	    get_binary_clauses(Cs, [C|Acc]);
+	false ->
+	    {lists:reverse(Acc),[C]}
+    end;
+get_binary_clauses([], Acc) ->
+    {lists:reverse(Acc),[]}.
+
+switch_cases([{N, L, C} | Cs], V, F, Next, Fail, Ctxt, Env, Body, S0) ->
+    S1 = add_code([icode_label(L)], S0),
+    S2 = Body(icode_const_val(N), V, C, F, Next, Fail, Ctxt, Env, S1),
+    switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S2);
+switch_cases([_ | Cs], V, F, Next, Fail, Ctxt, Env, Body, S) ->
+    switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S);
+switch_cases([], _V, _F, _Next, _Fail, _Ctxt, _Env, _Body, S) ->
+    S.
+
+%% Recall that the `final' and `effect' context flags distribute over
+%% the clause bodies.
+
+clauses(Cs, F, Vs, Ctxt, Env, S) ->
+    Next = new_continuation_label(Ctxt),
+    S1 = clauses_1(Cs, F, Vs, undefined, Next, Ctxt, Env, S),
+    add_continuation_label(Next, Ctxt, S1).
+
+clauses_1([C | Cs], F, Vs, Fail, Next, Ctxt, Env, S) ->
+    case cerl_clauses:is_catchall(C) of
+	true ->
+	    %% The fail label will not actually be used in this case.
+	    clause(C, F, Vs, Fail, Next, Ctxt, Env, S);
+	false ->
+	    %% The previous `Fail' is not used here.
+	    Fail1 = new_label(),
+	    S1 = clause(C, F, Vs, Fail1, Next, Ctxt, Env, S),
+	    S2 = add_code([icode_label(Fail1)], S1),
+	    clauses_1(Cs, F, Vs, Fail1, Next, Ctxt, Env, S2)
+    end;
+clauses_1([], _F, _Vs, Fail, _Next, Ctxt, _Env, S) ->
+    if Fail =:= undefined ->
+	    L = new_label(),
+	    add_default_case(L, Ctxt, S);
+       true ->
+	    add_code([icode_goto(Fail)], S)    % use existing label
+    end.
+
+%% The exact behaviour if all clauses fail is undefined; we generate an
+%% 'internal_error' exception if this happens, which is safe and will
+%% not get in the way of later analyses. (Continuing execution after the
+%% `case', as in a C `switch' statement, would add a new possible path
+%% to the program, which could destroy program properties.) Note that
+%% this code is only generated if some previous stage has created a
+%% switch over clauses without a final catch-all; this could be both
+%% legal and non-redundant, e.g. if the last clause does pattern
+%% matching to extract components of a (known) constructor. The
+%% generated default-case code *should* be unreachable, but we need it
+%% in order to have a safe fail-label.
+
+add_default_case(L, Ctxt, S) ->
+    S1 = add_code([icode_label(L)], S),
+    add_error(icode_const(internal_error), Ctxt, S1).
+
+clause(C, F, Vs, Fail, Next, Ctxt, Env, S) ->
+    G = cerl:clause_guard(C),
+    case cerl_clauses:eval_guard(G) of
+	{value, true} ->
+	    {Env1, S1} = patterns(cerl:clause_pats(C), Vs, Fail, Env,
+				  S),
+	    clause_body(C, F, Next, Ctxt, Env1, S1);
+	{value, false} ->
+	    add_code([icode_goto(Fail)], S);
+	_ ->
+	    {Env1, S1} = patterns(cerl:clause_pats(C), Vs, Fail, Env,
+				  S),
+	    Succ = new_label(),
+	    Ctxt1 = Ctxt#ctxt{final = false,
+			      fail = Fail,
+			      class = guard},
+	    S2 = boolean(G, Succ, Fail, Ctxt1, Env1, S1),
+	    S3 = add_code([icode_label(Succ)], S2),
+	    clause_body(C, F, Next, Ctxt, Env1, S3)
+    end.
+
+clause_body(C, F, Next, Ctxt, Env, S) ->
+    %% This check is inserted as a goto is always final 
+    case is_goto(cerl:clause_body(C)) of
+	true ->
+	    F(cerl:clause_body(C), Ctxt, Env, S);
+	false ->
+	    S1 = F(cerl:clause_body(C), Ctxt, Env, S),
+	    add_continuation_jump(Next, Ctxt, S1)
+    end.
+
+patterns([P | Ps], [V | Vs], Fail, Env, S) ->
+    {Env1, S1} = pattern(P, V, Fail, Env, S),
+    patterns(Ps, Vs, Fail, Env1, S1);
+patterns([], [], _, Env, S) ->
+    {Env, S}.
+
+pattern(P, V, Fail, Env, S) ->
+    case cerl:type(P) of
+	var ->
+	    {bind_var(P, V, Env), S};
+	alias ->
+	    {Env1, S1} = pattern(cerl:alias_pat(P), V,
+				 Fail, Env, S),
+	    {bind_var(cerl:alias_var(P), V, Env1), S1};
+	literal ->
+	    {Env, literal_pattern(P, V, Fail, S)};
+	cons ->
+	    cons_pattern(P, V, Fail, Env, S);
+	tuple ->
+	    tuple_pattern(P, V, Fail, Env, S);
+	binary ->
+	    binary_pattern(P, V, Fail, Env, S)
+    end.
+
+literal_pattern(P, V, Fail, S) ->
+    L = new_label(),
+    S1 = literal_pattern_1(P, V, Fail, L, S),
+    add_code([icode_label(L)], S1).
+
+literal_pattern_1(P, V, Fail, Next, S) ->
+    case cerl:concrete(P) of
+	X when is_atom(X) ->
+	    add_code([make_type([V], ?TYPE_ATOM(X), Next, Fail)],
+		     S);
+	X when is_integer(X) ->
+	    add_code([make_type([V], ?TYPE_INTEGER(X), Next, Fail)],
+		     S);
+	X when is_float(X) ->
+	    V1 = make_var(),
+	    L = new_label(),
+	    %% First doing an "is float" test here might allow later
+	    %% stages to use a specialized equality test.
+	    add_code([make_type([V], ?TYPE_IS_FLOAT, L, Fail),
+		      icode_label(L),
+		      icode_move(V1, icode_const(X)),
+		      make_if(?TEST_EQ, [V, V1], Next, Fail)],
+		     S);
+	[] ->
+	    add_code([make_type([V], ?TYPE_NIL, Next, Fail)], S);
+	X ->
+	    %% Compound constants are compared with the generic exact
+	    %% equality test.
+	    V1 = make_var(),
+	    add_code([icode_move(V1, icode_const(X)),
+		      make_if(?TEST_EXACT_EQ, [V, V1], Next, Fail)],
+		     S)
+    end.
+
+cons_pattern(P, V, Fail, Env, S) ->
+    V1 = make_var(),
+    V2 = make_var(),
+    Next = new_label(),
+    Ctxt = #ctxt{},
+    S1 = add_code([make_type([V], ?TYPE_CONS, Next, Fail),
+		   icode_label(Next)]
+		  ++ make_op(?OP_UNSAFE_HD, [V1], [V], Ctxt)
+		  ++ make_op(?OP_UNSAFE_TL, [V2], [V], Ctxt),
+		  S),
+    patterns([cerl:cons_hd(P), cerl:cons_tl(P)], [V1, V2],
+	     Fail, Env, S1).
+
+tuple_pattern(P, V, Fail, Env, S) ->
+    Es = cerl:tuple_es(P),
+    N = length(Es),
+    Vs = make_vars(N),
+    Next = new_label(),
+    S1 = add_code([make_type([V], ?TYPE_IS_N_TUPLE(N), Next, Fail),
+		   icode_label(Next)],
+		  S),
+    S2 = tuple_elements(Vs, V, S1),
+    patterns(Es, Vs, Fail, Env, S2).
+
+tuple_elements(Vs, V, S) ->
+    tuple_elements(Vs, V, #ctxt{}, 1, S).
+
+tuple_elements([V1 | Vs], V0, Ctxt, N, S) ->
+    Code = make_op(?OP_UNSAFE_ELEMENT(N), [V1], [V0], Ctxt),
+    tuple_elements(Vs, V0, Ctxt, N + 1, add_code(Code, S));
+tuple_elements([], _, _, _, S) ->
+    S.
+
+binary_pattern(P, V, Fail, Env, S) ->
+    L1 = new_label(),
+    Segs = cerl:binary_segments(P),
+    Arity = length(Segs),
+    Vars = make_vars(Arity),
+    MS = make_var(),
+    Primop1 = {hipe_bs_primop, {bs_start_match,0}},
+    S1 = add_code([icode_guardop([MS], Primop1, [V], L1, Fail),
+		   icode_label(L1)],S),
+    {Env1,S2} = bin_seg_patterns(Segs, Vars, MS, Fail, Env, S1, false),
+    L2 = new_label(),
+    Primop2 = {hipe_bs_primop, {bs_test_tail, 0}},
+    {Env1, add_code([icode_guardop([], Primop2, [MS], L2, Fail),
+		     icode_label(L2)], S2)}.
+
+bin_seg_patterns([Seg|Rest], [T|Ts], MS, Fail, Env, S, Align) ->
+    {{NewEnv, S1}, NewAlign} = bin_seg_pattern(Seg, T, MS, Fail, Env, S, Align),
+    bin_seg_patterns(Rest, Ts, MS, Fail, NewEnv, S1, NewAlign);
+
+bin_seg_patterns([], [], _MS, _Fail, Env, S, _Align) ->
+    {Env, S}.
+
+bin_seg_pattern(P, V, MS, Fail, Env, S, Align) ->
+    L = new_label(),
+    Size = cerl:bitstr_size(P),
+    Unit = cerl:bitstr_unit(P),
+    Type = cerl:concrete(cerl:bitstr_type(P)),
+    LiteralFlags = cerl:bitstr_flags(P),
+    T = cerl:bitstr_val(P), 
+    Flags = translate_flags(LiteralFlags, Align),
+    case calculate_size(Unit, Size, false, Env, S) of
+	{all, NewUnit, NewAlign, S0} ->
+	    Type = binary,
+	    Name = {bs_get_binary_all_2, NewUnit, Flags},
+	    Primop = {hipe_bs_primop, Name},
+	    S1 = add_code([icode_guardop([V,MS], Primop, [MS], L, Fail),
+			   icode_label(L)], S0),
+	    {pattern(T, V, Fail, Env, S1), NewAlign};	
+	{NewUnit, Args, S0, NewAlign} ->
+	    Name =
+		case Type of
+		    integer ->
+			{bs_get_integer, NewUnit, Flags};
+		    float ->
+			{bs_get_float, NewUnit, Flags};
+		    binary ->
+			{bs_get_binary, NewUnit, Flags}
+		end,
+	    Primop = {hipe_bs_primop, Name},
+	    S1 = add_code([icode_guardop([V,MS], Primop, [MS|Args], L, Fail),
+			   icode_label(L)], S0),
+	    {pattern(T, V, Fail, Env, S1), NewAlign}	
+    end.
+
+%% ---------------------------------------------------------------------
+%% Boolean expressions
+
+%% This generates code for a boolean expression (such as "primop
+%% 'and'(X, Y)") in a normal expression context, when an actual `true'
+%% or `false' value is to be computed. We set up a default fail-label
+%% for generating a `badarg' error, unless we are in a guard.
+
+boolean_expr(E, [V], Ctxt=#ctxt{class = guard}, Env, S) ->
+    {Code, True, False} = make_bool_glue(V),
+    S1 = boolean(E, True, False, Ctxt, Env, S),
+    add_code(Code, S1);
+boolean_expr(E, [V] = Ts, Ctxt, Env, S) ->
+    {Code, True, False} = make_bool_glue(V),
+    Fail = new_label(),
+    Cont = new_continuation_label(Ctxt),
+    Ctxt1 = Ctxt#ctxt{final = false, effect = false, fail = Fail},
+    S1 = boolean(E, True, False, Ctxt1, Env, S),
+    S2 = maybe_return(Ts, Ctxt, add_code(Code, S1)),
+    S3 = add_continuation_jump(Cont, Ctxt, S2),
+    S4 = add_code([icode_label(Fail)], S3),
+    S5 = add_error(icode_const(badarg), Ctxt, S4),  % can add dummy label
+    S6 = add_continuation_jump(Cont, Ctxt, S5),  % avoid empty basic block
+    add_continuation_label(Cont, Ctxt, S6);
+boolean_expr(_, [], _Ctxt, _Env, _S) ->
+    error_high_degree(),
+    throw(error);
+boolean_expr(_, _, _Ctxt, _Env, _S) ->
+    error_low_degree(),
+    throw(error).
+
+%% This is for when we expect a boolean result in jumping code context,
+%% but are not sure what the expression will produce, or we know that
+%% the result is not a boolean and we just want error handling.
+
+expect_boolean_value(E, True, False, Ctxt, Env, S) ->
+    V = make_var(),
+    S1 = expr(E, [V], Ctxt#ctxt{final = false}, Env, S),
+    case Ctxt#ctxt.fail of
+	[] ->
+	    %% No fail-label set - this means we are *sure* that the
+	    %% result can only be 'true' or 'false'.
+	    add_code([make_type([V], ?TYPE_ATOM(true), True, False)],
+		     S1);
+	Fail ->
+	    Next = new_label(),
+	    add_code([make_type([V], ?TYPE_ATOM(true), True, Next),
+		      icode_label(Next),
+		      make_type([V], ?TYPE_ATOM(false), False, Fail)],
+		     S1)
+    end.
+
+%% This generates code for a case-switch with exactly one 'true' branch
+%% and one 'false' branch, and no other branches (not even a catch-all).
+%% Note that E must be guaranteed to produce a boolean value for such a
+%% switch to have been generated.
+
+bool_switch(E, TrueExpr, FalseExpr, F, Ctxt, Env, S) ->
+    Cont = new_continuation_label(Ctxt),
+    True = new_label(),
+    False = new_label(),
+    Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+    S1 = boolean(E, True, False, Ctxt1, Env, S),
+    S2 = add_code([icode_label(True)], S1),
+    S3 = F(TrueExpr, Ctxt, Env, S2),
+    S4 = add_continuation_jump(Cont, Ctxt, S3),
+    S5 = add_code([icode_label(False)], S4),
+    S6 = F(FalseExpr, Ctxt, Env, S5),
+    add_continuation_label(Cont, Ctxt, S6).
+
+%% This generates jumping code for booleans. If the fail-label is set,
+%% it tells where to go in case a value turns out not to be a boolean.
+
+%% In strict boolean expressions, we set a flag to be checked if
+%% necessary after both branches have been evaluated. An alternative
+%% would be to duplicate the code for the second argument, for each
+%% value ('true' or 'false') of the first argument.
+
+%% (Note that subexpressions are checked repeatedly to see if they are
+%% safe - this is quadratic, but I don't expect booleans to be very
+%% deeply nested.)
+
+%% Note that 'and', 'or' and 'xor' are strict (like all primops)!
+
+boolean(E0, True, False, Ctxt, Env, S) ->
+    E = cerl_lib:reduce_expr(E0),
+    case cerl:type(E) of
+	literal ->
+	    case cerl:concrete(E) of
+		true ->
+		    add_code([icode_goto(True)], S);
+		false ->
+		    add_code([icode_goto(False)], S);
+		_ ->
+		    expect_boolean_value(E, True, False, Ctxt, Env, S)
+	    end;
+	values ->
+	    case cerl:values_es(E) of
+		[E1] ->
+		    boolean(E1, True, False, Ctxt, Env, S);
+		_ ->
+		    error_msg("degree mismatch - expected boolean: ~P",
+			      [E, 10]),
+		    throw(error)
+	    end;
+	primop ->
+	    Name = cerl:atom_val(cerl:primop_name(E)),
+	    As = cerl:primop_args(E),
+	    Arity = length(As),
+	    case {Name, Arity} of
+		{?PRIMOP_NOT, 1} ->
+		    %% `not' simply switches true and false labels.
+		    [A] = As,
+		    boolean(A, False, True, Ctxt, Env, S);
+		{?PRIMOP_AND, 2} ->
+		    strict_and(As, True, False, Ctxt, Env, S);
+		{?PRIMOP_OR, 2} ->
+		    strict_or(As, True, False, Ctxt, Env, S);
+		{?PRIMOP_XOR, 2} ->
+		    %% `xor' always needs to evaluate both arguments
+		    strict_xor(As, True, False, Ctxt, Env, S);
+		_ ->
+		    case is_comp_op(Name, Arity) of
+			true ->
+			    comparison(Name, As, True, False, Ctxt, Env,
+				       S);
+			false ->
+			    case is_type_test(Name, Arity) of
+				true ->
+				    type_test(Name, As, True, False,
+					      Ctxt, Env, S);
+				false ->
+				    expect_boolean_value(E, True, False,
+							 Ctxt, Env, S)
+			    end
+		    end
+	    end;
+ 	'case' ->
+	    %% Propagate boolean handling into clause bodies.
+	    %% (Note that case switches assume fallthrough code in the
+	    %% clause bodies, so we must add a dummy label as needed.)
+	    F = fun (BF, CtxtF, EnvF, SF) ->
+			SF1 = boolean(BF, True, False, CtxtF, EnvF, SF),
+			add_new_continuation_label(CtxtF, SF1)
+		end,
+	    S1 = expr_case_1(E, F, Ctxt, Env, S),
+	    %% Add a final goto if necessary, to compensate for the
+	    %% final continuation label of the case-expression. This
+	    %% should be unreachable, so the value does not matter.
+	    add_continuation_jump(False, Ctxt, S1);
+	seq ->
+	    %% Propagate boolean handling into body.
+	    F = fun (BF, CtxtF, EnvF, SF) ->
+			boolean(BF, True, False, CtxtF, EnvF, SF)
+		end,
+	    expr_seq_1(E, F, Ctxt, Env, S);
+	'let' ->
+	    %% Propagate boolean handling into body. Note that we have
+	    %% called 'cerl_lib:reduce_expr/1' above.
+	    F = fun (BF, CtxtF, EnvF, SF) ->
+			boolean(BF, True, False, CtxtF, EnvF, SF)
+		end,
+	    expr_let_1(E, F, Ctxt, Env, S);
+	'try' ->
+	    case Ctxt#ctxt.class of
+		guard ->
+		    %% This *must* be a "protected" guard expression on
+		    %% the form "try E of X -> X catch <...> -> 'false'"
+		    %% (we could of course test if the handler body is
+		    %% the atom 'false', etc.).
+		    Ctxt1 = Ctxt#ctxt{fail = False},
+		    boolean(cerl:try_arg(E), True, False, Ctxt1, Env, S);
+		_ ->
+		    %% Propagate boolean handling into the handler and body
+		    %% (see propagation into case switches for comparison)
+		    F = fun (BF, CtxtF, EnvF, SF) ->
+				boolean(BF, True, False, CtxtF, EnvF, SF)
+			end,
+		    S1 = expr_try_1(E, F, Ctxt, Env, S),
+		    add_continuation_jump(False, Ctxt, S1)
+	    end;
+	_ ->
+	    %% This handles everything else, including cases that are
+	    %% known to not return a boolean.
+	    expect_boolean_value(E, True, False, Ctxt, Env, S)
+    end.
+
+strict_and([A, B], True, False, Ctxt, Env, S) ->
+    V = make_var(),
+    {Glue, True1, False1} = make_bool_glue(V),
+    S1 = boolean(A, True1, False1, Ctxt, Env, S),
+    S2 = add_code(Glue, S1),
+    Test = new_label(),
+    S3 = boolean(B, Test, False, Ctxt, Env, S2),
+    add_code([icode_label(Test),
+	      make_bool_test(V, True, False)],
+	     S3).
+
+strict_or([A, B], True, False, Ctxt, Env, S) ->
+    V = make_var(),
+    {Glue, True1, False1} = make_bool_glue(V),
+    S1 = boolean(A, True1, False1, Ctxt, Env, S),
+    S2 = add_code(Glue, S1),
+    Test = new_label(),
+    S3 = boolean(B, True, Test, Ctxt, Env, S2),
+    add_code([icode_label(Test),
+	      make_bool_test(V, True, False)],
+	     S3).
+
+strict_xor([A, B], True, False, Ctxt, Env, S) ->
+    V = make_var(),
+    {Glue, True1, False1} = make_bool_glue(V),
+    S1 = boolean(A, True1, False1, Ctxt, Env, S),
+    S2 = add_code(Glue, S1),
+    Test1 = new_label(),
+    Test2 = new_label(),
+    S3 = boolean(B, Test1, Test2, Ctxt, Env, S2),
+    add_code([icode_label(Test1),
+	      make_bool_test(V, False, True),
+	      icode_label(Test2),
+	      make_bool_test(V, True, False)],
+	     S3).
+
+%% Primitive comparison operations are inline expanded as conditional
+%% branches when part of a boolean expression, rather than made into
+%% primop or guardop calls. Note that Without type information, we
+%% cannot reduce equality tests like `Expr == true' to simply `Expr'
+%% (and `Expr == false' to `not Expr'), because we are not sure that
+%% Expr will yield a boolean - if it does not, the result of the
+%% comparison should be `false'.
+
+comparison(Name, As, True, False, Ctxt, Env, S) ->
+    {Vs, S1} = expr_list(As, Ctxt, Env, S),
+    Test = comp_test(Name),
+    add_code([make_if(Test, Vs, True, False)], S1).
+
+comp_test(?PRIMOP_EQ) -> ?TEST_EQ;
+comp_test(?PRIMOP_NE) -> ?TEST_NE;
+comp_test(?PRIMOP_EXACT_EQ) -> ?TEST_EXACT_EQ;
+comp_test(?PRIMOP_EXACT_NE) -> ?TEST_EXACT_NE;
+comp_test(?PRIMOP_LT) -> ?TEST_LT;
+comp_test(?PRIMOP_GT) -> ?TEST_GT;
+comp_test(?PRIMOP_LE) -> ?TEST_LE;
+comp_test(?PRIMOP_GE) -> ?TEST_GE.
+
+type_test(?PRIMOP_IS_RECORD, [T, A, N], True, False, Ctxt, Env, S) ->
+    is_record_test(T, A, N, True, False, Ctxt, Env, S);
+type_test(Name, [A], True, False, Ctxt, Env, S) ->
+    V = make_var(),
+    S1 = expr(A, [V], Ctxt#ctxt{final = false, effect = false}, Env, S),
+    Test = type_test(Name),
+    add_code([make_type([V], Test, True, False)], S1).
+
+%% It turned out to be easiest to generate Icode directly for this. 
+is_record_test(T, A, N, True, False, Ctxt, Env, S) ->
+    case cerl:is_c_atom(A) andalso cerl:is_c_int(N)
+	andalso (cerl:concrete(N) > 0) of
+	true ->
+	    V = make_var(),
+	    Ctxt1 = Ctxt#ctxt{final = false, effect = false},
+	    S1 = expr(T, [V], Ctxt1, Env, S),
+	    Atom = cerl:concrete(A),
+	    Size = cerl:concrete(N),
+	    add_code([make_type([V], ?TYPE_IS_RECORD(Atom, Size), True, False)],
+		     S1);
+	false ->
+	    error_primop_badargs(?PRIMOP_IS_RECORD, [T, A, N]),
+	    throw(error)
+    end.
+
+type_test(?PRIMOP_IS_ATOM) -> ?TYPE_IS_ATOM;
+type_test(?PRIMOP_IS_BIGNUM) -> ?TYPE_IS_BIGNUM;
+type_test(?PRIMOP_IS_BINARY) -> ?TYPE_IS_BINARY;
+type_test(?PRIMOP_IS_CONSTANT) -> ?TYPE_IS_CONSTANT;
+type_test(?PRIMOP_IS_FIXNUM) -> ?TYPE_IS_FIXNUM;
+type_test(?PRIMOP_IS_FLOAT) -> ?TYPE_IS_FLOAT;
+type_test(?PRIMOP_IS_FUNCTION) -> ?TYPE_IS_FUNCTION;
+type_test(?PRIMOP_IS_INTEGER) -> ?TYPE_IS_INTEGER;
+type_test(?PRIMOP_IS_LIST) -> ?TYPE_IS_LIST;
+type_test(?PRIMOP_IS_NUMBER) -> ?TYPE_IS_NUMBER;
+type_test(?PRIMOP_IS_PID) -> ?TYPE_IS_PID;
+type_test(?PRIMOP_IS_PORT) -> ?TYPE_IS_PORT;
+type_test(?PRIMOP_IS_REFERENCE) -> ?TYPE_IS_REFERENCE;
+type_test(?PRIMOP_IS_TUPLE) -> ?TYPE_IS_TUPLE.
+
+is_comp_op(?PRIMOP_EQ, 2) -> true;
+is_comp_op(?PRIMOP_NE, 2) -> true;
+is_comp_op(?PRIMOP_EXACT_EQ, 2) -> true;
+is_comp_op(?PRIMOP_EXACT_NE, 2) -> true;
+is_comp_op(?PRIMOP_LT, 2) -> true;
+is_comp_op(?PRIMOP_GT, 2) -> true;
+is_comp_op(?PRIMOP_LE, 2) -> true;
+is_comp_op(?PRIMOP_GE, 2) -> true;
+is_comp_op(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+is_bool_op(?PRIMOP_AND, 2) -> true;
+is_bool_op(?PRIMOP_OR, 2) -> true;
+is_bool_op(?PRIMOP_XOR, 2) -> true;
+is_bool_op(?PRIMOP_NOT, 1) -> true;
+is_bool_op(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+is_type_test(?PRIMOP_IS_ATOM, 1) -> true;
+is_type_test(?PRIMOP_IS_BIGNUM, 1) -> true;
+is_type_test(?PRIMOP_IS_BINARY, 1) -> true;
+is_type_test(?PRIMOP_IS_CONSTANT, 1) -> true;
+is_type_test(?PRIMOP_IS_FIXNUM, 1) -> true;
+is_type_test(?PRIMOP_IS_FLOAT, 1) -> true;
+is_type_test(?PRIMOP_IS_FUNCTION, 1) -> true;
+is_type_test(?PRIMOP_IS_INTEGER, 1) -> true;
+is_type_test(?PRIMOP_IS_LIST, 1) -> true;
+is_type_test(?PRIMOP_IS_NUMBER, 1) -> true;
+is_type_test(?PRIMOP_IS_PID, 1) -> true;
+is_type_test(?PRIMOP_IS_PORT, 1) -> true;
+is_type_test(?PRIMOP_IS_REFERENCE, 1) -> true;
+is_type_test(?PRIMOP_IS_TUPLE, 1) -> true;
+is_type_test(?PRIMOP_IS_RECORD, 3) -> true;
+is_type_test(Op, A) when is_atom(Op), is_integer(A) -> false.
+
+
+%% ---------------------------------------------------------------------
+%% Utility functions
+
+bind_var(V, Name, Env) ->
+    env__bind(cerl:var_name(V), #cerl_to_icode__var{name = Name}, Env).
+
+bind_vars([V | Vs], [X | Xs], Env) ->
+    bind_vars(Vs, Xs, bind_var(V, X, Env));
+bind_vars([], [], Env) ->
+    Env.
+
+bind_fun(V, L, Vs, Env) ->
+    env__bind(cerl:var_name(V), #'fun'{label = L, vars = Vs}, Env).
+
+add_code(Code, S) ->
+    s__add_code(Code, S).
+
+%% This inserts code when necessary for assigning the targets in the
+%% first list to those in the second.
+
+glue([V1 | Vs1], [V2 | Vs2], S) ->
+    if V1 =:= V2 ->
+	    S;
+       true ->
+	    glue(Vs1, Vs2, add_code([icode_move(V2, V1)], S))
+    end;
+glue([], [], S) ->
+    S;
+glue([], _, S) ->
+    warning_low_degree(),
+    S;
+glue(_, [], _) ->
+    error_high_degree(),
+    throw(error).
+
+make_moves([V1 | Vs1], [V2 | Vs2]) ->
+    [icode_move(V1, V2) | make_moves(Vs1, Vs2)];
+make_moves([], []) ->
+    [].
+
+%% If the context signals `final', we generate a return instruction,
+%% otherwise nothing happens.
+
+maybe_return(Ts, Ctxt, S) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    S;
+	true ->
+	    add_return(Ts, S)
+    end.
+
+add_return(Ts, S) ->
+    add_code([icode_return(Ts)], S).
+
+new_continuation_label(Ctxt) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    new_label();
+	true ->
+	    undefined
+    end.
+
+add_continuation_label(Label, Ctxt, S) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    add_code([icode_label(Label)], S);
+	true ->
+	    S
+    end.
+
+add_continuation_jump(Label, Ctxt, S) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    add_code([icode_goto(Label)], S);
+	true ->
+	    S
+    end.
+
+%% This is used to insert a new dummy label (if necessary) when
+%% a block is ended suddenly; cf. add_fail.
+add_new_continuation_label(Ctxt, S) ->
+    add_continuation_label(new_continuation_label(Ctxt), Ctxt, S).
+
+add_local_call({Name, _Arity} = V, Vs, Ts, Ctxt, S) ->
+    Module = s__get_module(S),
+    case Ctxt#ctxt.final of
+	false ->
+	    add_code([icode_call_local(Ts, Module, Name, Vs)], S);
+	true ->
+	    Self = s__get_function(S),
+	    if V =:= Self ->
+		    %% Self-recursive tail call:
+		    {Label, Vs1} = s__get_local_entry(S),
+		    add_code(make_moves(Vs1, Vs) ++ [icode_goto(Label)],
+			     S);
+	       true ->
+		    add_code([icode_enter_local(Module, Name, Vs)], S)
+	    end
+    end.
+
+%% Note that this has the same "problem" as the fail instruction (see
+%% the 'add_fail' function), namely, that it unexpectedly ends a basic
+%% block. The solution is the same - add a dummy label if necessary.
+
+add_letrec_call(Label, Vs1, Vs, Ctxt, S) ->
+    S1 = add_code(make_moves(Vs1, Vs) ++ [icode_goto(Label)], S),
+    add_new_continuation_label(Ctxt, S1).
+
+add_exit(V, Ctxt, S) ->
+    add_fail([V], exit, Ctxt, S).
+
+add_throw(V, Ctxt, S) ->
+    add_fail([V], throw, Ctxt, S).
+
+add_error(V, Ctxt, S) ->
+    add_fail([V], error, Ctxt, S).
+
+add_error(V, F, Ctxt, S) ->
+    add_fail([V, F], error, Ctxt, S).
+
+add_rethrow(E, V, Ctxt, S) ->
+    add_fail([E, V], rethrow, Ctxt, S).
+
+%% Failing is special, because it can "suddenly" end the basic block,
+%% even though the context was expecting the code to fall through, for
+%% instance when you have a call to 'exit(X)' that is not in a tail call
+%% context. In those cases a dummy label must therefore be added after
+%% the fail instruction, to start a new (but unreachable) basic block.
+
+add_fail(Vs, Class, Ctxt, S0) ->
+    S1 = add_code([icode_fail(Vs, Class)], S0),
+    add_new_continuation_label(Ctxt, S1).
+
+%% We must add continuation- and fail-labels if we are in a guard context.
+
+make_op(Name, Ts, As, Ctxt) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    case Ctxt#ctxt.class of
+		guard ->
+		    Next = new_label(),
+		    [icode_guardop(Ts, Name, As, Next, Ctxt#ctxt.fail),
+		     icode_label(Next)];
+		_ ->
+		    [icode_call_primop(Ts, Name, As)]
+	    end;	
+	true ->
+	    [icode_enter_primop(Name, As)]
+    end.
+
+make_call(M, F, Ts, As, Ctxt) ->
+    case Ctxt#ctxt.final of
+	false ->
+	    case Ctxt#ctxt.class of
+		guard ->
+		    Next = new_label(),
+		    [icode_call_remote(Ts, M, F, As, Next,
+				       Ctxt#ctxt.fail, true),
+		     icode_label(Next)];
+		_ ->
+		    [icode_call_remote(Ts, M, F, As)]
+	    end;
+	true ->
+	    %% A final call can't be in a guard anyway
+	    [icode_enter_remote(M, F, As)]
+    end.
+
+%% Recognize useless tests that always go to the same label. This often
+%% happens as an artefact of the translation.
+
+make_if(_, _, Label, Label) ->
+    icode_goto(Label);
+make_if(Test, As, True, False) ->
+    icode_if(Test, As, True, False).
+
+make_type(_, _, Label, Label) ->
+    icode_goto(Label);
+make_type(Vs, Test, True, False) ->
+    icode_type(Vs, Test, True, False).
+
+%% Creating glue code with true/false target labels for assigning a
+%% corresponding 'true'/'false' value to a specific variable. Used as
+%% glue between boolean jumping code and boolean values.
+
+make_bool_glue(V) ->
+    make_bool_glue(V, true, false).
+
+make_bool_glue(V, T, F) ->
+    False = new_label(),
+    True = new_label(),
+    Next = new_label(),
+    Code = [icode_label(False), 
+	    icode_move(V, icode_const(F)),
+	    icode_goto(Next),
+	    icode_label(True),
+	    icode_move(V, icode_const(T)),
+	    icode_label(Next)],
+    {Code, True, False}.
+
+make_bool_test(V, True, False) ->
+    make_type([V], ?TYPE_ATOM(true), True, False).
+
+%% Checking if an expression is safe
+
+is_safe_expr(E) ->
+    cerl_lib:is_safe_expr(E, fun function_check/2).
+
+function_check(safe, {Name, Arity}) ->
+    is_safe_op(Name, Arity);
+function_check(safe, {Module, Name, Arity}) ->
+    erl_bifs:is_safe(Module, Name, Arity);
+function_check(pure, {Name, Arity}) ->
+    is_pure_op(Name, Arity);
+function_check(pure, {Module, Name, Arity}) ->
+    erl_bifs:is_pure(Module, Name, Arity);
+function_check(_, _) ->
+    false.
+
+%% There are very few really safe operations (sigh!). If we have type
+%% information, several operations could be rewritten into specialized
+%% safe versions, such as '+'/2 -> add_integer/2.
+
+is_safe_op(N, A) ->
+    is_comp_op(N, A) orelse is_type_test(N, A).
+
+is_pure_op(?PRIMOP_ELEMENT, 2) -> true;
+is_pure_op(?PRIMOP_MAKE_FUN, 6) -> true;
+is_pure_op(?PRIMOP_FUN_ELEMENT, 2) -> true;
+is_pure_op(?PRIMOP_ADD, 2) -> true;
+is_pure_op(?PRIMOP_SUB, 2) -> true;
+is_pure_op(?PRIMOP_NEG, 1) -> true;
+is_pure_op(?PRIMOP_MUL, 2) -> true;
+is_pure_op(?PRIMOP_DIV, 2) -> true;
+is_pure_op(?PRIMOP_INTDIV, 2) -> true;
+is_pure_op(?PRIMOP_REM, 2) -> true;
+is_pure_op(?PRIMOP_BAND, 2) -> true;
+is_pure_op(?PRIMOP_BOR, 2) -> true;
+is_pure_op(?PRIMOP_BXOR, 2) -> true;
+is_pure_op(?PRIMOP_BNOT, 1) -> true;
+is_pure_op(?PRIMOP_BSL, 2) -> true;
+is_pure_op(?PRIMOP_BSR, 2) -> true;
+is_pure_op(?PRIMOP_EXIT, 1) -> true;
+is_pure_op(?PRIMOP_THROW, 1) -> true;
+is_pure_op(?PRIMOP_ERROR, 1) -> true;
+is_pure_op(?PRIMOP_ERROR, 2) -> true;
+is_pure_op(?PRIMOP_RETHROW, 2) -> true;
+is_pure_op(N, A) -> is_pure_op_aux(N, A).
+
+is_pure_op_aux(N, A) ->
+    is_bool_op(N, A) orelse is_comp_op(N, A) orelse is_type_test(N, A).
+
+translate_flags(Flags, Align) ->
+    translate_flags1(cerl:concrete(Flags), Align).
+
+translate_flags1([A|Rest], Align) ->
+    case A of
+	signed ->
+	    4 + translate_flags1(Rest, Align);
+	little ->
+	    2 + translate_flags1(Rest, Align);
+	native ->
+	    case hipe_rtl_arch:endianess() of
+		little ->
+		    2 + translate_flags1(Rest, Align);
+		big ->
+		    translate_flags1(Rest, Align)
+	    end;
+	_ ->
+	    translate_flags1(Rest, Align)
+    end;
+translate_flags1([], Align) ->
+    case Align of
+	0 ->
+	    1;
+	_ ->
+	    0
+    end.
+
+get_const_info(Val, integer) ->
+    case {cerl:is_c_var(Val), cerl:is_c_int(Val)} of
+	{true, _} ->
+	    var;
+	{_, true} ->
+	    pass;
+	_ ->
+	    fail
+    end;
+get_const_info(Val, float) ->
+    case {cerl:is_c_var(Val), cerl:is_c_float(Val)} of
+	{true, _} ->
+	    var;
+	{_, true} ->
+	    pass;
+	_ ->
+	    fail
+    end;
+get_const_info(_Val, _Type) ->
+    [].
+
+calculate_size(Unit, Var, Align, Env, S) ->
+    case cerl:is_c_atom(Var) of
+	true ->
+	    {cerl:atom_val(Var), cerl:concrete(Unit), Align, S};
+	false ->
+	    case cerl:is_c_int(Var) of
+		true ->
+		    NewVal = cerl:concrete(Var) * cerl:concrete(Unit),  
+		    NewAlign =
+			case Align of
+			    false ->
+				false
+			    %% Currently, all uses of the function are
+			    %% with "Aligned == false", and this case
+			    %% is commented out to shut up Dialyzer. 
+			    %% _ ->
+			    %%	(NewVal+Align) band 7
+			end,
+		    {NewVal, [], S, NewAlign};
+		false ->
+		    NewSize = make_var(),
+		    S1 = expr(Var, [NewSize], #ctxt{final=false}, Env, S), 
+		    NewAlign =
+			case cerl:concrete(Unit) band 7 of
+			    0 ->
+				Align;
+			    _ ->
+				false
+			end,
+		    {cerl:concrete(Unit), [NewSize], S1, NewAlign}
+	    end
+    end.
+
+
+%% ---------------------------------------------------------------------
+%% Environment (abstract datatype)
+
+env__new() ->
+    rec_env:empty().
+
+env__bind(Key, Val, Env) ->
+    rec_env:bind(Key, Val, Env).
+
+env__lookup(Key, Env) ->
+    rec_env:lookup(Key, Env).
+
+env__get(Key, Env) ->
+    rec_env:get(Key, Env).
+
+%% env__new_integer_keys(N, Env) ->
+%%     rec_env:new_keys(N, Env).
+
+
+%% ---------------------------------------------------------------------
+%% State (abstract datatype)
+
+-record(state, {module, function, local, labels=gb_trees:empty(), 
+		code = [], pmatch=true, bitlevel_binaries=false}).
+
+s__new(Module) ->
+    #state{module = Module}.
+
+s__get_module(S) ->
+    S#state.module.
+
+s__set_function(Name, S) ->
+    S#state{function = Name}.
+
+s__get_function(S) ->
+    S#state.function.
+
+s__set_local_entry(Info, S) ->
+    S#state{local = Info}.
+
+s__get_local_entry(S) ->
+    S#state.local.
+
+%% Generated code is kept in reverse order, to make adding fast.
+
+s__set_code(Code, S) ->
+    S#state{code = lists:reverse(Code)}.
+
+s__get_code(S) ->
+    lists:reverse(S#state.code).
+
+s__add_code(Code, S) ->
+    S#state{code = lists:reverse(Code, S#state.code)}.
+
+s__get_label(Ref, S) ->
+    Labels = S#state.labels,
+    case gb_trees:lookup(Ref, Labels) of
+	none ->
+	    Label = new_label(),
+	    S1 = S#state{labels=gb_trees:enter(Ref, Label, Labels)},
+	    {Label, S1};
+	{value, Label} -> 
+	    {Label,S}
+    end.
+
+s__set_pmatch(V, S) ->
+    S#state{pmatch = V}.
+
+s__get_pmatch(S) ->
+    S#state.pmatch.
+
+s__set_bitlevel_binaries(true, S) ->
+    S#state{bitlevel_binaries = true};
+s__set_bitlevel_binaries(_, S) ->
+    S#state{bitlevel_binaries = false}.
+
+s__get_bitlevel_binaries(S) ->
+    S#state.bitlevel_binaries.
+%% ---------------------------------------------------------------------
+%%% Match label State
+
+%-record(mstate,{labels=gb_trees:empty()}).
+
+%get_correct_label(Alias, MState=#mstate{labels=Labels}) ->
+%    case gb_trees:lookup(Alias, Labels) of
+%    none ->
+%      LabelName=new_label(),
+%      {LabelName, MState#mstate{labels=gb_trees:insert(Alias, LabelName, Labels)}};
+%    {value, LabelName} ->
+%      {LabelName, MState}
+%  end.
+
+
+%% ---------------------------------------------------------------------
+%% General utilities
+
+reset_var_counter() ->
+    hipe_gensym:set_var(0).
+
+reset_label_counter() ->
+    hipe_gensym:set_label(0).
+
+new_var() ->
+    hipe_gensym:get_next_var().
+
+new_label() ->
+    hipe_gensym:get_next_label().
+
+max_var() ->
+    hipe_gensym:get_var().
+
+max_label() ->
+    hipe_gensym:get_label().
+
+make_var() ->
+    icode_var(new_var()).
+
+make_vars(N) when N > 0 ->
+    [make_var() | make_vars(N - 1)];
+make_vars(0) ->
+    [].
+
+make_reg() ->
+    icode_reg(new_var()).
+
+
+%% ---------------------------------------------------------------------
+%% ICode interface
+
+icode_icode(M, {F, A}, Vs, Closure, C, V, L) ->
+    MFA = {M, F, A},
+    hipe_icode:mk_icode(MFA, Vs, Closure, false, C, V, L).
+
+icode_icode_name(Icode) ->
+    hipe_icode:icode_fun(Icode).
+
+icode_comment(S) -> hipe_icode:mk_comment(S).
+
+icode_var(V) -> hipe_icode:mk_var(V).
+
+icode_reg(V) -> hipe_icode:mk_reg(V).
+
+icode_label(L) -> hipe_icode:mk_label(L).
+
+icode_move(V, D) -> hipe_icode:mk_move(V, D).
+
+icode_const(X) -> hipe_icode:mk_const(X).
+
+icode_const_val(X) -> hipe_icode:const_value(X).
+
+icode_call_local(Ts, M, N, Vs) ->
+    hipe_icode:mk_call(Ts, M, N, Vs, local).
+
+icode_call_remote(Ts, M, N, Vs) ->
+    hipe_icode:mk_call(Ts, M, N, Vs, remote).
+
+icode_call_remote(Ts, M, N, Vs, Cont, Fail, Guard) ->
+    hipe_icode:mk_call(Ts, M, N, Vs, remote, Cont, Fail, Guard).
+
+icode_enter_local(M, N, Vs) ->
+    hipe_icode:mk_enter(M, N, Vs, local).
+
+icode_enter_remote(M, N, Vs) ->
+    hipe_icode:mk_enter(M, N, Vs, remote).
+
+icode_call_fun(Ts, Vs) ->
+    icode_call_primop(Ts, call_fun, Vs).
+
+icode_enter_fun(Vs) ->
+    icode_enter_primop(enter_fun, Vs).
+
+icode_begin_try(L,Cont) -> hipe_icode:mk_begin_try(L,Cont).
+
+icode_end_try() -> hipe_icode:mk_end_try().
+
+icode_begin_handler(Ts) -> hipe_icode:mk_begin_handler(Ts).
+
+icode_goto(L) -> hipe_icode:mk_goto(L).
+
+icode_return(Ts) -> hipe_icode:mk_return(Ts).
+
+icode_fail(Vs, C) -> hipe_icode:mk_fail(Vs, C).
+
+icode_guardop(Ts, Name, As, Succ, Fail) ->
+    hipe_icode:mk_guardop(Ts, Name, As, Succ, Fail).
+
+icode_call_primop(Ts, Name, As) -> hipe_icode:mk_primop(Ts, Name, As).
+
+icode_call_primop(Ts, Name, As, Succ, Fail) ->
+    hipe_icode:mk_primop(Ts, Name, As, Succ, Fail).
+
+icode_enter_primop(Name, As) -> hipe_icode:mk_enter_primop(Name, As).
+
+icode_if(Test, As, True, False) ->
+    hipe_icode:mk_if(Test, As, True, False).
+
+icode_type(Test, As, True, False) ->
+    hipe_icode:mk_type(Test, As, True, False).
+
+icode_switch_val(Arg, Fail, Length, Cases) ->
+    hipe_icode:mk_switch_val(Arg, Fail, Length, Cases).
+
+icode_switch_tuple_arity(Arg, Fail, Length, Cases) ->
+    SortedCases = lists:keysort(1, Cases), %% immitate BEAM compiler - Kostis
+    hipe_icode:mk_switch_tuple_arity(Arg, Fail, Length, SortedCases).
+
+
+%% ---------------------------------------------------------------------
+%% Error reporting
+
+error_not_in_receive(Name) ->
+    error_msg("primitive operation `~w' missing receive-context.",
+	      [Name]).
+
+low_degree() ->
+    "degree of expression less than expected.".
+
+warning_low_degree() ->
+    warning_msg(low_degree()).
+
+error_low_degree() ->
+    error_msg(low_degree()).
+
+error_high_degree() ->
+    error_msg("degree of expression greater than expected.").
+
+error_degree_mismatch(N, E) ->
+    error_msg("expression does not have expected degree (~w): ~P.",
+	      [N, E, 10]).
+
+error_nonlocal_application(Op) ->
+    error_msg("application operator not a local function: ~P.",
+	      [Op, 10]).
+
+error_primop_badargs(Op, As) ->
+    error_msg("bad arguments to `~w' operation: ~P.",
+	      [Op, As, 15]).
+
+%% internal_error_msg(S) ->
+%%     internal_error_msg(S, []).
+
+%% internal_error_msg(S, Vs) ->
+%%     error_msg(lists:concat(["Internal error: ", S]), Vs).
+
+error_msg(S) ->
+    error_msg(S, []).
+
+error_msg(S, Vs) ->
+    error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+warning_msg(S) ->
+    warning_msg(S, []).
+
+warning_msg(S, Vs) ->
+    info_msg(lists:concat(["warning: ", S]), Vs).
+
+%% info_msg(S) ->
+%%     info_msg(S, []).
+
+info_msg(S, Vs) ->
+    error_logger:info_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
+
+
+%% --------------------------------------------------------------------------
+%% Binary stuff
+
+binary_match([Clause|Clauses], F, [V], Next, Fail, Ctxt, Env, S) ->
+    Guard = cerl:clause_guard(Clause),
+    Body = cerl:clause_body(Clause),
+    [Pat] = cerl:clause_pats(Clause),
+    {FL,S1} = s__get_label(translate_label_primop(Guard),S),
+    {Env1,S2} = binary_pattern(Pat,V,FL,Env,S1),
+    S3 = F(Body, Ctxt, Env1, S2),
+    S4 = add_continuation_jump(Next, Ctxt, S3),
+    S5 = add_code([icode_label(FL)], S4),
+    binary_match(Clauses, F, [V], Next, Fail, Ctxt, Env, S5);
+binary_match([], _F, _, _Next, Fail, _Ctxt, _Env, S) ->
+    add_code([icode_goto(Fail)], S).
+
+translate_label_primop(LabelPrimop) ->
+    ?PRIMOP_SET_LABEL = cerl:atom_val(cerl:primop_name(LabelPrimop)),
+    [Ref] = cerl:primop_args(LabelPrimop),
+    Ref.    
+
+
diff --git a/lib/hipe/cerl/cerl_typean.erl b/lib/hipe/cerl/cerl_typean.erl
new file mode 100644
index 0000000000..ccd8903658
--- /dev/null
+++ b/lib/hipe/cerl/cerl_typean.erl
@@ -0,0 +1,1003 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% Type analysis of Core Erlang programs.
+%%
+%% Copyright (C) 2001-2002 Richard Carlsson
+%%
+%% Author contact: [email protected]
+%%
+%% @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()}.
+
+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/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
new file mode 100644
index 0000000000..0f57a93a7c
--- /dev/null
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -0,0 +1,5021 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% =====================================================================
+%% Type information for Erlang Built-in functions (implemented in C)
+%%
+%% Copyright (C) 2002 Richard Carlsson
+%% Copyright (C) 2006 Richard Carlsson, Tobias Lindahl and Kostis Sagonas
+%%
+%% Author contact: [email protected], [email protected], [email protected]
+%% =====================================================================
+
+-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.
+-define(TAG_IMMED1_SIZE, 4).
+
+-export([type/3, type/4, arg_types/3, 
+	 is_known/3, structure_inspecting_args/3, infinity_add/2]).
+
+-import(erl_types, [number_max/1,
+		    number_min/1,
+		    t_any/0,
+		    t_arity/0,
+		    t_atom/0,
+		    t_atom/1,
+		    t_atoms/1,
+		    t_atom_vals/1,
+		    t_binary/0,
+		    t_bitstr/0,
+		    t_boolean/0,
+		    t_byte/0,
+		    t_char/0,
+		    t_cons/0,
+		    t_cons/2,
+		    t_cons_hd/1,
+		    t_cons_tl/1,
+		    t_constant/0,
+		    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/1,
+		    t_fun_range/1,
+		    t_identifier/0,
+		    t_inf/2,
+		    t_integer/0,
+		    t_integer/1,
+		    t_non_neg_fixnum/0,
+		    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_binary/1,
+		    t_is_bitstr/1,
+		    t_is_boolean/1,
+		    t_is_cons/1,
+		    t_is_constant/1,
+		    t_is_float/1,
+		    t_is_float/1,
+		    t_is_fun/1,
+		    t_is_integer/1,
+		    t_is_integer/1,
+		    t_is_list/1,
+		    t_is_nil/1,
+		    t_is_none/1,
+		    t_is_none_or_unit/1,
+		    t_is_number/1,
+		    t_is_pid/1,
+		    t_is_port/1,
+		    t_is_maybe_improper_list/1,
+		    t_is_reference/1,
+		    t_is_string/1,
+		    t_is_subtype/2,
+		    t_is_tuple/1,
+		    t_list/0,
+		    t_list/1,
+		    t_list_elements/1,
+		    t_list_termination/1,
+		    t_mfa/0,
+		    t_nil/0,
+		    t_node/0,
+		    t_none/0,
+		    t_nonempty_list/0,
+		    t_nonempty_list/1,
+		    t_number/0,
+		    t_number_vals/1,
+		    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_tid/0,
+		    t_timeout/0,
+		    t_tuple/0,
+		    t_tuple/1,
+		    t_tuple_args/1,
+		    t_tuple_size/1,
+		    t_tuple_subtypes/1
+		   ]).
+
+-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().
+
+%%-- code ---------------------------------------------------------------------
+type(code, add_path, 1, Xs) ->
+  strict(arg_types(code, add_path, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_boolean(),
+		   t_tuple([t_atom('error'), t_atom('bad_directory')]))
+	 end);
+type(code, add_patha, 1, Xs) ->
+  type(code, add_path, 1, Xs);
+type(code, add_paths, 1, Xs) ->
+  strict(arg_types(code, add_paths, 1), Xs, fun(_) -> t_atom('ok') end);
+type(code, add_pathsa, 1, Xs) ->
+  type(code, add_paths, 1, Xs);
+type(code, add_pathsz, 1, Xs) ->
+  type(code, add_paths, 1, Xs);
+type(code, add_pathz, 1, Xs) ->
+  type(code, add_path, 1, Xs);
+type(code, all_loaded, 0, _) ->
+  t_list(t_tuple([t_atom(), t_code_loaded_fname_or_status()]));
+type(code, compiler_dir, 0, _) ->
+  t_string();
+type(code, del_path, 1, Xs) ->
+  strict(arg_types(code, del_path, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_boolean(),
+		   t_tuple([t_atom('error'), t_atom('bad_name')]))
+	 end);
+type(code, delete, 1, Xs) ->
+  strict(arg_types(code, delete, 1), Xs, fun (_) -> t_boolean() end);
+type(code, ensure_loaded, 1, Xs) ->
+  type(code, load_file, 1, Xs);
+type(code, get_chunk, 2, Xs) ->
+  strict(arg_types(code, get_chunk, 2), Xs,
+	 fun (_) -> t_sup(t_binary(), t_atom('undefined')) end);
+type(code, get_object_code, 1, Xs) ->
+  strict(arg_types(code, get_object_code, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom(), t_binary(), t_string()]),
+		   t_atom('error'))
+	 end);
+type(code, get_path, 0, _) ->
+  t_list(t_string());
+type(code, is_loaded, 1, Xs) ->
+  strict(arg_types(code, is_loaded, 1), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('file'), t_code_loaded_fname_or_status()]),
+		    t_atom('false')])
+	 end);
+type(code, is_sticky, 1, Xs) ->
+  strict(arg_types(code, is_sticky, 1), Xs, fun (_) -> t_boolean() end);
+type(code, is_module_native, 1, Xs) ->
+  strict(arg_types(code, is_module_native, 1), Xs,
+	 fun (_) -> t_sup(t_boolean(), t_atom('undefined')) end);
+type(code, lib_dir, 0, _) ->
+  t_string();
+type(code, lib_dir, 1, Xs) ->
+  strict(arg_types(code, lib_dir, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_string(),
+ 		   t_tuple([t_atom('error'), t_atom('bad_name')]))
+ 	 end);
+type(code, load_abs, 1, Xs) ->
+  strict(arg_types(code, load_abs, 1), Xs,
+	 fun ([_File]) -> t_code_load_return(t_atom()) end);	% XXX: cheating
+type(code, load_abs, 2, Xs) ->
+  strict(arg_types(code, load_abs, 2), Xs,
+	 fun ([_File,Mod]) -> t_code_load_return(Mod) end);
+type(code, load_binary, 3, Xs) ->
+  strict(arg_types(code, load_binary, 3), Xs,
+	 fun ([Mod,_File,_Bin]) -> t_code_load_return(Mod) end);
+type(code, load_file, 1, Xs) ->
+  strict(arg_types(code, load_file, 1), Xs,
+	 fun ([Mod]) -> t_code_load_return(Mod) end);
+type(code, load_native_partial, 2, Xs) ->
+  strict(arg_types(code, load_native_partial, 2), Xs,
+	 fun ([Mod,_Bin]) -> t_code_load_return(Mod) end);
+type(code, load_native_sticky, 3, Xs) ->
+  strict(arg_types(code, load_native_sticky, 3), Xs,
+        fun ([Mod,_Bin,_]) -> t_code_load_return(Mod) end);
+type(code, module_md5, 1, Xs) ->
+  strict(arg_types(code, module_md5, 1), Xs,
+	 fun (_) -> t_sup(t_binary(), t_atom('undefined')) end);
+type(code, make_stub_module, 3, Xs) ->
+  strict(arg_types(code, make_stub_module, 3), Xs, fun ([Mod,_,_]) -> Mod end);
+type(code, priv_dir, 1, Xs) ->
+  strict(arg_types(code, priv_dir, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_string(), t_tuple([t_atom('error'), t_atom('bad_name')]))
+	 end);
+type(code, purge, 1, Xs) ->
+  type(code, delete, 1, Xs);
+type(code, rehash, 0, _) -> t_atom('ok');
+type(code, replace_path, 2, Xs) ->
+  strict(arg_types(code, replace_path, 2), Xs,
+	 fun (_) ->
+	     t_sup([t_atom('true'),
+		    t_tuple([t_atom('error'), t_atom('bad_name')]),
+		    t_tuple([t_atom('error'), t_atom('bad_directory')]),
+		    t_tuple([t_atom('error'),
+			     t_tuple([t_atom('badarg'), t_any()])])])
+	 end);
+type(code, root_dir, 0, _) ->
+  t_string();
+type(code, set_path, 1, Xs) ->
+  strict(arg_types(code, set_path, 1), Xs,
+	 fun (_) ->
+	     t_sup([t_atom('true'),
+		    t_tuple([t_atom('error'), t_atom('bad_path')]),
+		    t_tuple([t_atom('error'), t_atom('bad_directory')])])
+	 end);
+type(code, soft_purge, 1, Xs) ->
+  type(code, delete, 1, Xs);
+type(code, stick_mod, 1, Xs) ->
+  strict(arg_types(code, stick_mod, 1), Xs, fun (_) -> t_atom('true') end);
+type(code, unstick_mod, 1, Xs) ->
+  type(code, stick_mod, 1, Xs);
+type(code, which, 1, Xs) ->
+  strict(arg_types(code, which, 1), Xs,
+	 fun (_) ->
+	     t_sup([t_code_loaded_fname_or_status(),
+		    t_atom('non_existing')])
+	 end);
+%%-- erl_ddll -----------------------------------------------------------------
+type(erl_ddll, demonitor, 1, Xs) ->
+  type(erlang, demonitor, 1, Xs);
+type(erl_ddll, format_error_int, 1, Xs) ->
+  strict(arg_types(erl_ddll, format_error_int, 1), Xs,
+	 fun (_) -> t_string() end);
+type(erl_ddll, info, 2, Xs) ->
+  strict(arg_types(erl_ddll, info, 2), Xs, fun (_) -> t_atom() end);
+type(erl_ddll, loaded_drivers, 0, _) ->
+  t_tuple([t_atom('ok'), t_list(t_string())]);
+type(erl_ddll, monitor, 2, Xs) -> % return type is the same, though args are not
+  type(erlang, monitor, 2, Xs);
+type(erl_ddll, try_load, 3, Xs) ->
+  strict(arg_types(erl_ddll, try_load, 3), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('ok'), t_atom('already_loaded')]),
+		    t_tuple([t_atom('ok'), t_atom('loaded')]),
+		    t_tuple([t_atom('ok'),
+			     t_atom('pending_driver'), t_reference()]),
+		    t_tuple([t_atom('error'), t_atom('inconsistent')]),
+		    t_tuple([t_atom('error'), t_atom('permanent')])])
+	 end);
+type(erl_ddll, try_unload, 2, Xs) ->
+  strict(arg_types(erl_ddll, try_unload, 2), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('ok'), t_atom('pending_process')]),
+		    t_tuple([t_atom('ok'), t_atom('unloaded')]),
+		    t_tuple([t_atom('ok'), t_atom('pending_driver')]),
+		    t_tuple([t_atom('ok'),
+			     t_atom('pending_driver'), t_reference()]),
+		    t_tuple([t_atom('error'), t_atom('permanent')]),
+		    t_tuple([t_atom('error'), t_atom('not_loaded')]),
+		    t_tuple([t_atom('error'),
+			     t_atom('not_loaded_by_this_process')])])
+	 end);
+%%-- erlang -------------------------------------------------------------------
+type(erlang, halt, 0, _) -> t_none();
+type(erlang, halt, 1, _) -> t_none();
+type(erlang, exit, 1, _) -> t_none();
+%% Note that exit/2 sends an exit signal to another process.
+type(erlang, exit, 2, _) -> t_atom('true');
+type(erlang, error, 1, _) -> t_none();
+type(erlang, error, 2, _) -> t_none();
+type(erlang, throw, 1, _) -> t_none();
+type(erlang, hibernate, 3, _) -> t_none();
+type(erlang, '==', 2, Xs = [X1, X2]) ->
+  case t_is_atom(X1) andalso t_is_atom(X2) of
+    true -> type(erlang, '=:=', 2, Xs);
+    false ->
+      case t_is_integer(X1) andalso t_is_integer(X2) of
+	true -> type(erlang, '=:=', 2, Xs);
+	false -> strict(Xs, t_boolean())
+      end
+  end;
+type(erlang, '/=', 2, Xs = [X1, X2]) -> 
+  case t_is_atom(X1) andalso t_is_atom(X2) of
+    true -> type(erlang, '=/=', 2, Xs);
+    false ->
+      case t_is_integer(X1) andalso t_is_integer(X2) of
+	true -> type(erlang, '=/=', 2, Xs);
+	false -> strict(Xs, t_boolean())
+      end
+  end;
+type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> 
+  Ans =
+    case t_is_none(t_inf(Lhs, Rhs)) of
+      true -> t_atom('false');
+      false ->
+	case t_is_atom(Lhs) andalso t_is_atom(Rhs) of
+	  true ->
+	    case {t_atom_vals(Lhs), t_atom_vals(Rhs)} 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) andalso t_is_integer(Rhs) of
+	      false -> t_boolean();
+	      true ->
+		case {t_number_vals(Lhs), t_number_vals(Rhs)} of
+		  {[X], [X]} when is_integer(X) -> t_atom('true');
+		  _ ->
+		    LhsMax = number_max(Lhs),
+		    LhsMin = number_min(Lhs),
+		    RhsMax = number_max(Rhs),
+		    RhsMin = number_min(Rhs),
+		    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,
+  strict(Xs, Ans);
+type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) ->
+  Ans =
+    case t_is_none(t_inf(Lhs, Rhs)) of
+      true -> t_atom('true');
+      false ->
+	case t_is_atom(Lhs) andalso t_is_atom(Rhs) of
+	  true ->
+	    case {t_atom_vals(Lhs), t_atom_vals(Rhs)} 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) andalso t_is_integer(Rhs) of
+	      false -> t_boolean();
+	      true ->
+		LhsMax = number_max(Lhs),
+		LhsMin = number_min(Lhs),
+		RhsMax = number_max(Rhs),
+		RhsMin = number_min(Rhs),
+		Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax)
+			andalso (LhsMin > RhsMax)),
+		Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin)
+			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,
+  strict(Xs, Ans);
+type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> 
+  Ans =
+    case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+      true ->
+	LhsMax = number_max(Lhs),
+	LhsMin = number_min(Lhs),
+	RhsMax = number_max(Rhs),
+	RhsMin = number_min(Rhs),
+	T = t_atom('true'),
+	F = t_atom('false'),
+	if 
+	  is_integer(LhsMin), is_integer(RhsMax), LhsMin > RhsMax -> T;
+	  is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F;
+	  true -> t_boolean()
+	end;
+      false -> t_boolean()
+    end,
+  strict(Xs, Ans);
+type(erlang, '>=', 2, Xs = [Lhs, Rhs]) ->
+  Ans =
+    case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+      true ->
+	LhsMax = number_max(Lhs),
+	LhsMin = number_min(Lhs),
+	RhsMax = number_max(Rhs),
+	RhsMin = number_min(Rhs),
+	T = t_atom('true'),
+	F = t_atom('false'),
+	if 
+	  is_integer(LhsMin), is_integer(RhsMax), LhsMin >= RhsMax -> T;
+	  is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F;
+	  true -> t_boolean()
+	end;
+      false -> t_boolean()
+    end,
+  strict(Xs, Ans);
+type(erlang, '<', 2, Xs = [Lhs, Rhs]) ->
+  Ans =
+    case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+      true ->
+	LhsMax = number_max(Lhs),
+	LhsMin = number_min(Lhs),
+	RhsMax = number_max(Rhs),
+	RhsMin = number_min(Rhs),
+	T = t_atom('true'),
+	F = t_atom('false'),
+	if 
+	  is_integer(LhsMax), is_integer(RhsMin), LhsMax < RhsMin -> T;
+	  is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F;
+	  true -> t_boolean()
+	end;
+      false -> t_boolean()
+    end,
+  strict(Xs, Ans);
+type(erlang, '=<', 2, Xs = [Lhs, Rhs]) ->
+  Ans =
+    case t_is_integer(Lhs) andalso t_is_integer(Rhs) of
+      true ->
+	LhsMax = number_max(Lhs),
+	LhsMin = number_min(Lhs),
+	RhsMax = number_max(Rhs),
+	RhsMin = number_min(Rhs),
+	T = t_atom('true'),
+	F = t_atom('false'),
+	if 
+	  is_integer(LhsMax), is_integer(RhsMin), LhsMax =< RhsMin -> T;
+	  is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F;
+	  true -> t_boolean()
+	end;
+      false -> t_boolean()
+    end,
+  strict(Xs, Ans);
+type(erlang, '+', 1, Xs) ->
+  strict(arg_types(erlang, '+', 1), Xs, 
+	 fun ([X]) -> X end);
+type(erlang, '-', 1, Xs) ->
+  strict(arg_types(erlang, '-', 1), Xs, 
+	 fun ([X]) -> 
+	     case t_is_integer(X) of
+	       true -> type(erlang, '-', 2, [t_integer(0), X]);
+	       false -> X
+	     end
+	 end);
+type(erlang, '!', 2, Xs) ->
+  strict(arg_types(erlang, '!', 2), Xs, fun ([_, X2]) -> X2 end);
+type(erlang, '+', 2, Xs) ->
+  strict(arg_types(erlang, '+', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('+', X1, X2) of
+	       {ok, T} -> T;
+	       error ->
+		 case t_is_float(X1) orelse t_is_float(X2) of
+		   true -> t_float();
+		   false -> t_number()
+		 end
+	     end
+	 end);
+type(erlang, '-', 2, Xs) ->
+  strict(arg_types(erlang, '-', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('-', X1, X2) of
+	       {ok, T} -> T;
+	       error ->
+		 case t_is_float(X1) orelse t_is_float(X2) of
+		   true -> t_float();
+		   false -> t_number()
+		 end
+	     end
+	 end);
+type(erlang, '*', 2, Xs) ->
+  strict(arg_types(erlang, '*', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('*', X1, X2) of
+	       {ok, T} -> T;
+	       error ->
+		 case t_is_float(X1) orelse t_is_float(X2) of
+		   true -> t_float();
+		   false -> t_number()
+		 end
+	     end
+	 end);
+type(erlang, '/', 2, Xs) ->
+  strict(arg_types(erlang, '/', 2), Xs,
+	 fun (_) -> t_float() end);
+type(erlang, 'div', 2, Xs) ->
+  strict(arg_types(erlang, 'div', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('div', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+type(erlang, 'rem', 2, Xs) ->
+  strict(arg_types(erlang, 'rem', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('rem', X1, X2) of
+	       error -> t_non_neg_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+type(erlang, '++', 2, Xs) ->
+  strict(arg_types(erlang, '++', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case t_is_nil(X1) of
+	       true  -> X2;    % even if X2 is not a list
+	       false ->
+		 case t_is_nil(X2) of
+		   true  -> X1;
+		   false ->
+		     E1 = t_list_elements(X1),
+		     case t_is_cons(X1) of
+		       true -> t_cons(E1, X2);
+		       false ->
+			 t_sup(X2, t_cons(E1, X2))
+		     end
+		 end
+	     end
+	 end);
+type(erlang, '--', 2, Xs) ->
+  %% We don't know which elements (if any) in X2 will be found and
+  %% removed from X1, even if they would have the same type. Thus, we
+  %% must assume that X1 can remain unchanged. However, if we succeed,
+  %% we know that X1 must be a proper list, but the result could
+  %% possibly be empty even if X1 is nonempty.
+  strict(arg_types(erlang, '--', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case t_is_nil(X1) of
+	       true  -> t_nil();
+	       false ->
+		 case t_is_nil(X2) of
+		   true  -> X1;
+		   false -> t_list(t_list_elements(X1))
+		 end
+	     end
+	 end);
+type(erlang, 'and', 2, Xs) ->
+  strict(arg_types(erlang, 'and', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'or', 2, Xs) ->
+  strict(arg_types(erlang, 'or', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'xor', 2, Xs) ->
+  strict(arg_types(erlang, 'xor', 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'not', 1, Xs) ->
+  strict(arg_types(erlang, 'not', 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, 'band', 2, Xs) ->
+  strict(arg_types(erlang, 'band', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('band', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% The result is not wider than the smallest argument. We need to
+%% kill any value-sets in the result.
+%%  strict(arg_types(erlang, 'band', 2), Xs,
+%%	 fun ([X1, X2]) -> t_sup(t_inf(X1, X2), t_byte()) end);
+type(erlang, 'bor', 2, Xs) ->
+  strict(arg_types(erlang, 'bor', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('bor', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% The result is not wider than the largest argument. We need to
+%% kill any value-sets in the result.
+%%  strict(arg_types(erlang, 'bor', 2), Xs,
+%%	 fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end);
+type(erlang, 'bxor', 2, Xs) ->
+  strict(arg_types(erlang, 'bxor', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('bxor', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% The result is not wider than the largest argument. We need to
+%% kill any value-sets in the result.
+%%  strict(arg_types(erlang, 'bxor', 2), Xs,
+%%	 fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end);
+type(erlang, 'bsr', 2, Xs) ->
+  strict(arg_types(erlang, 'bsr', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('bsr', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% If the first argument is unsigned (which is the case for
+%% characters and bytes), the result is never wider. We need to kill
+%% any value-sets in the result.
+%%  strict(arg_types(erlang, 'bsr', 2), Xs,
+%%	 fun ([X, _]) -> t_sup(X, t_byte()) end);
+type(erlang, 'bsl', 2, Xs) ->
+  strict(arg_types(erlang, 'bsl', 2), Xs,
+	 fun ([X1, X2]) ->
+	     case arith('bsl', X1, X2) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% Not worth doing anything special here.
+%%  strict(arg_types(erlang, 'bsl', 2), Xs, fun (_) -> t_integer() end);
+type(erlang, 'bnot', 1, Xs) ->
+ strict(arg_types(erlang, 'bnot', 1), Xs,
+	 fun ([X1]) ->
+	     case arith('bnot', X1) of
+	       error -> t_integer();
+	       {ok, T} -> T
+	     end
+	 end);
+%% This returns (-X)-1, so it often gives a negative result.
+%%  strict(arg_types(erlang, 'bnot', 1), Xs, fun (_) -> t_integer() end);
+type(erlang, abs, 1, Xs) ->
+  strict(arg_types(erlang, abs, 1), Xs, fun ([X]) -> X end);
+type(erlang, append_element, 2, Xs) ->
+  strict(arg_types(erlang, append_element, 2), Xs, fun (_) -> t_tuple() end);
+type(erlang, apply, 2, Xs) ->
+  Fun = fun ([X, _Y]) -> 
+	    case t_is_fun(X) of
+	      true ->
+		t_fun_range(X);
+	      false ->
+		t_any() 
+	    end
+	end,
+  strict(arg_types(erlang, apply, 2), Xs, Fun);
+type(erlang, apply, 3, Xs) ->
+  strict(arg_types(erlang, apply, 3), Xs, fun (_) -> t_any() end);
+type(erlang, atom_to_binary, 2, Xs) ->
+  strict(arg_types(erlang, atom_to_binary, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, atom_to_list, 1, Xs) ->
+  strict(arg_types(erlang, atom_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, binary_to_atom, 2, Xs) ->
+  strict(arg_types(erlang, binary_to_atom, 2), Xs, fun (_) -> t_atom() end);
+type(erlang, binary_to_existing_atom, 2, Xs) ->
+  type(erlang, binary_to_atom, 2, Xs);
+type(erlang, binary_to_list, 1, Xs) ->
+  strict(arg_types(erlang, binary_to_list, 1), Xs,
+	 fun (_) -> t_list(t_byte()) end);
+type(erlang, binary_to_list, 3, Xs) ->
+  strict(arg_types(erlang, binary_to_list, 3), Xs,
+	 fun (_) -> t_list(t_byte()) end);
+type(erlang, binary_to_term, 1, Xs) ->
+  strict(arg_types(erlang, binary_to_term, 1), Xs, fun (_) -> t_any() end);
+type(erlang, bitsize, 1, Xs) ->	% XXX: TAKE OUT
+  type(erlang, bit_size, 1, Xs);
+type(erlang, bit_size, 1, Xs) ->
+  strict(arg_types(erlang, bit_size, 1), Xs,
+	 fun (_) -> t_non_neg_integer() end);
+type(erlang, bitstr_to_list, 1, Xs) ->	% XXX: TAKE OUT
+  type(erlang, bitstring_to_list, 1, Xs);
+type(erlang, bitstring_to_list, 1, Xs) ->
+  strict(arg_types(erlang, bitstring_to_list, 1), Xs,
+	 fun (_) -> t_list(t_sup(t_byte(), t_bitstr())) end);
+type(erlang, bump_reductions, 1, Xs) ->
+  strict(arg_types(erlang, bump_reductions, 1), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, byte_size, 1, Xs) ->
+  strict(arg_types(erlang, byte_size, 1), Xs,
+	 fun (_) -> t_non_neg_integer() end);
+type(erlang, cancel_timer, 1, Xs) ->
+  strict(arg_types(erlang, cancel_timer, 1), Xs,
+	 fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(erlang, check_process_code, 2, Xs) ->
+  strict(arg_types(erlang, check_process_code, 2), Xs,
+	 fun (_) -> t_boolean() end);
+type(erlang, concat_binary, 1, Xs) ->
+  strict(arg_types(erlang, concat_binary, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, crc32, 1, Xs) ->
+  strict(arg_types(erlang, crc32, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, crc32, 2, Xs) ->
+  strict(arg_types(erlang, crc32, 2), Xs, fun (_) -> t_integer() end);
+type(erlang, crc32_combine, 3, Xs) ->
+  strict(arg_types(erlang, crc32_combine, 3), Xs, fun (_) -> t_integer() end);
+type(erlang, date, 0, _) ->
+  t_date();
+type(erlang, decode_packet, 3, Xs) ->
+  strict(arg_types(erlang, decode_packet, 3), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('ok'), t_packet(), t_binary()]),
+		    t_tuple([t_atom('more'), t_sup([t_non_neg_integer(),
+						    t_atom('undefined')])]),
+		    t_tuple([t_atom('error'), t_any()])])
+	 end);
+type(erlang, delete_module, 1, Xs) ->
+  strict(arg_types(erlang, delete_module, 1), Xs,
+ 	 fun (_) -> t_sup(t_atom('true'), t_atom('undefined')) end);
+type(erlang, demonitor, 1, Xs) ->
+  strict(arg_types(erlang, demonitor, 1), Xs, fun (_) -> t_atom('true') end);
+%% TODO: overapproximation -- boolean only if 'info' is part of arg2 otherwise 'true'
+type(erlang, demonitor, 2, Xs) ->
+  strict(arg_types(erlang, demonitor, 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, disconnect_node, 1, Xs) ->
+  strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, display, 1, _) -> t_atom('true');
+type(erlang, dist_exit, 3, Xs) ->
+  strict(arg_types(erlang, dist_exit, 3), Xs, fun (_) -> t_atom('true') end);
+type(erlang, element, 2, Xs) ->
+  strict(arg_types(erlang, element, 2), Xs,
+	 fun ([X1, X2]) ->
+	     case t_tuple_subtypes(X2) of
+	       unknown -> t_any();
+	       [_] ->
+		 Sz = t_tuple_size(X2),
+		 As = t_tuple_args(X2),
+		 case t_number_vals(X1) of
+		   unknown -> t_sup(As);
+		   Ns when is_list(Ns) ->
+		     Fun = fun 
+			     (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);
+type(erlang, erase, 0, _) -> t_any();
+type(erlang, erase, 1, _) -> t_any();
+type(erlang, external_size, 1, _) -> t_integer();
+type(erlang, float, 1, Xs) ->
+  strict(arg_types(erlang, float, 1), Xs, fun (_) -> t_float() end);
+type(erlang, float_to_list, 1, Xs) ->
+  strict(arg_types(erlang, float_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, function_exported, 3, Xs) ->
+  strict(arg_types(erlang, function_exported, 3), Xs,
+	 fun (_) -> t_boolean() end);
+type(erlang, fun_info, 1, Xs) ->
+  strict(arg_types(erlang, fun_info, 1), Xs,
+	 fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end);
+type(erlang, fun_info, 2, Xs) ->
+  strict(arg_types(erlang, fun_info, 2), Xs,
+	 fun (_) -> t_tuple([t_atom(), t_any()]) end);
+type(erlang, fun_to_list, 1, Xs) ->
+  strict(arg_types(erlang, fun_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, garbage_collect, 0, _) -> t_atom('true');
+type(erlang, garbage_collect, 1, Xs) ->
+  strict(arg_types(erlang, garbage_collect, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, get, 0, _) -> t_list(t_tuple(2));
+type(erlang, get, 1, _) -> t_any();          % | t_atom('undefined')
+type(erlang, get_cookie, 0, _) -> t_atom();  % | t_atom('nocookie')
+type(erlang, get_keys, 1, _) -> t_list();
+type(erlang, get_module_info, 1, Xs) ->
+  strict(arg_types(erlang, get_module_info, 1), Xs,
+	 fun (_) ->
+	     t_list(t_tuple([t_atom(), t_list(t_tuple([t_atom(), t_any()]))]))
+	 end);
+type(erlang, get_module_info, 2, Xs) ->
+  T_module_info_2_returns =
+    t_sup([t_atom(),
+	   t_list(t_tuple([t_atom(), t_any()])),
+	   t_list(t_tuple([t_atom(), t_arity(), t_integer()]))]),
+  strict(arg_types(erlang, get_module_info, 2), Xs,
+	 fun ([Module, Item]) ->
+	     case t_is_atom(Item) of
+	       true -> 
+		 case t_atom_vals(Item) of
+		   ['module'] -> t_inf(t_atom(), Module);
+		   ['imports'] -> t_nil();
+		   ['exports'] -> t_list(t_tuple([t_atom(), t_arity()]));
+		   ['functions'] -> t_list(t_tuple([t_atom(), t_arity()]));
+		   ['attributes'] -> t_list(t_tuple([t_atom(), t_any()]));
+		   ['compile'] -> t_list(t_tuple([t_atom(), t_any()]));
+		   ['native_addresses'] -> % [{FunName, Arity, Address}]
+		     t_list(t_tuple([t_atom(), t_arity(), t_integer()]));
+		   List when is_list(List) ->
+		     T_module_info_2_returns;
+		   unknown ->
+		     T_module_info_2_returns
+		 end;
+	       false ->
+		 T_module_info_2_returns
+	     end
+	 end);
+type(erlang, get_stacktrace, 0, _) ->
+  t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()])]));
+type(erlang, group_leader, 0, _) -> t_pid();
+type(erlang, group_leader, 2, Xs) ->
+  strict(arg_types(erlang, group_leader, 2), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, hash, 2, Xs) ->
+  strict(arg_types(erlang, hash, 2), Xs, fun (_) -> t_integer() end);
+type(erlang, hd, 1, Xs) ->
+  strict(arg_types(erlang, hd, 1), Xs, fun ([X]) -> t_cons_hd(X) end);
+type(erlang, integer_to_list, 1, Xs) ->
+  strict(arg_types(erlang, integer_to_list, 1), Xs,
+	 fun (_) -> t_string() end);
+type(erlang, info, 1, Xs) -> type(erlang, system_info, 1, Xs); % alias
+type(erlang, iolist_size, 1, Xs) ->
+  strict(arg_types(erlang, iolist_size, 1), Xs,
+	 fun (_) -> t_non_neg_integer() end);
+type(erlang, iolist_to_binary, 1, Xs) ->
+  strict(arg_types(erlang, iolist_to_binary, 1), Xs,
+	 fun (_) -> t_binary() end);
+type(erlang, is_alive, 0, _) -> t_boolean();
+type(erlang, is_atom, 1, Xs) ->   
+  Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_atom(Y) end, t_atom()) end,
+  strict(arg_types(erlang, is_atom, 1), Xs, Fun);
+type(erlang, is_binary, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_binary(Y) end, t_binary())
+	end,
+  strict(arg_types(erlang, is_binary, 1), Xs, Fun);
+type(erlang, is_bitstr, 1, Xs) ->	% XXX: TAKE OUT
+  type(erlang, is_bitstring, 1, Xs);
+type(erlang, is_bitstring, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_bitstr(Y) end, t_bitstr())
+	end,
+  strict(arg_types(erlang, is_bitstring, 1), Xs, Fun);
+type(erlang, is_boolean, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_boolean(Y) end, t_boolean())
+	end,
+  strict(arg_types(erlang, is_boolean, 1), Xs, Fun);
+type(erlang, is_builtin, 3, Xs) ->
+  strict(arg_types(erlang, is_builtin, 3), Xs, fun (_) -> t_boolean() end);
+type(erlang, is_constant, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_constant(Y) end, t_constant())
+	end,
+  strict(arg_types(erlang, is_constant, 1), Xs, Fun);
+type(erlang, is_float, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_float(Y) end, t_float())
+	end,
+  strict(arg_types(erlang, is_float, 1), Xs, Fun);
+type(erlang, is_function, 1, Xs) ->
+  Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_fun(Y) end, t_fun()) end,
+  strict(arg_types(erlang, is_function, 1), Xs, Fun);
+type(erlang, is_function, 2, Xs) ->
+  Fun = fun ([FunType, ArityType]) -> 
+	    case t_number_vals(ArityType) of
+	      unknown -> t_boolean();
+	      [Val] -> 
+		FunConstr = t_fun(any_list(Val), t_any()),
+		Fun2 = fun (X) ->
+			   t_is_subtype(X, FunConstr) andalso (not t_is_none(X))
+		       end,
+		check_guard_single(FunType, Fun2, FunConstr);
+	      IntList when is_list(IntList) -> t_boolean() %% true?
+	    end
+	end,
+  strict(arg_types(erlang, is_function, 2), Xs, Fun);
+type(erlang, is_integer, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_integer(Y) end, t_integer())
+	end,
+  strict(arg_types(erlang, is_integer, 1), Xs, Fun);
+type(erlang, is_list, 1, Xs) ->
+  Fun = fun (X) ->
+	    Fun2 = fun (Y) -> t_is_maybe_improper_list(Y) end,
+	    check_guard(X, Fun2, t_maybe_improper_list())
+	end,
+  strict(arg_types(erlang, is_list, 1), Xs, Fun);
+type(erlang, is_number, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_number(Y) end, t_number())
+	end,
+  strict(arg_types(erlang, is_number, 1), Xs, Fun);
+type(erlang, is_pid, 1, Xs) ->
+  Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_pid(Y) end, t_pid()) end,
+  strict(arg_types(erlang, is_pid, 1), Xs, Fun);
+type(erlang, is_port, 1, Xs) ->
+  Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_port(Y) end, t_port()) end,
+  strict(arg_types(erlang, is_port, 1), Xs, Fun);
+type(erlang, is_process_alive, 1, Xs) ->
+  strict(arg_types(erlang, is_process_alive, 1), Xs,
+	 fun (_) -> t_boolean() end);
+type(erlang, is_record, 2, Xs) ->
+  Fun = fun ([X, Y]) ->
+	    case t_is_tuple(X) of
+	      false ->
+		case t_is_none(t_inf(t_tuple(), X)) of
+		  true -> t_atom('false');
+		  false -> t_boolean()
+		end;
+	      true ->
+		case t_tuple_subtypes(X) of
+		  unknown -> t_boolean();
+		  [Tuple] ->
+		    case t_tuple_args(Tuple) of
+		      %% any -> t_boolean();
+		      [Tag|_] ->
+			case t_is_atom(Tag) of
+			  false ->
+			    TagAtom = t_inf(Tag, t_atom()),
+			    case t_is_none(TagAtom) of
+			      true -> t_atom('false');
+			      false -> t_boolean()
+			    end;
+			  true ->
+			    case t_atom_vals(Tag) of
+			      [RealTag] -> 
+				case t_atom_vals(Y) of
+				  [RealTag] -> t_atom('true');
+				  _ -> t_boolean() 
+				end;
+			      _ -> t_boolean()
+			    end
+			end
+		    end;
+		  List when length(List) >= 2 ->
+		    t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List])
+		end
+	    end
+	end,
+  strict(arg_types(erlang, is_record, 2), Xs, Fun);
+type(erlang, is_record, 3, Xs) ->
+  Fun = fun ([X, Y, Z]) ->
+	    Arity = t_number_vals(Z),
+	    case t_is_tuple(X) of
+	      false when length(Arity) =:= 1 ->
+		[RealArity] = Arity,
+		case t_is_none(t_inf(t_tuple(RealArity), X)) of
+		  true -> t_atom('false');
+		  false -> t_boolean()
+		end;
+	      false ->
+		case t_is_none(t_inf(t_tuple(), X)) of
+		  true -> t_atom('false');
+		  false -> t_boolean()
+		end;
+	      true when length(Arity) =:= 1 ->
+		[RealArity] = Arity,
+		case t_tuple_subtypes(X) of
+		  unknown -> t_boolean();
+		  [Tuple] ->
+		    case t_tuple_args(Tuple) of
+		      %% any -> t_boolean();
+		      Args when length(Args) =:= RealArity ->
+			Tag = hd(Args),
+			case t_is_atom(Tag) of
+			  false ->
+			    TagAtom = t_inf(Tag, t_atom()),
+			    case t_is_none(TagAtom) of
+			      true -> t_atom('false');
+			      false -> t_boolean()
+			    end;
+			  true ->
+			    case t_atom_vals(Tag) of
+			      [RealTag] -> 
+				case t_atom_vals(Y) of
+				  [RealTag] -> t_atom('true');
+				  _ -> t_boolean()
+				end;
+			      _ -> t_boolean()
+			    end
+			end;
+		      Args when length(Args) =/= RealArity ->
+			t_atom('false')
+		    end;
+		  [_, _|_] ->
+		    t_boolean()
+		end;
+	      true ->
+		t_boolean()
+	    end
+	end,
+  strict(arg_types(erlang, is_record, 3), Xs, Fun);
+type(erlang, is_reference, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_reference(Y) end, t_reference())
+	end,
+  strict(arg_types(erlang, is_reference, 1), Xs, Fun);
+type(erlang, is_tuple, 1, Xs) ->
+  Fun = fun (X) ->
+	    check_guard(X, fun (Y) -> t_is_tuple(Y) end, t_tuple())
+	end,
+  strict(arg_types(erlang, is_tuple, 1), Xs, Fun);
+type(erlang, length, 1, Xs) ->
+  strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end);
+type(erlang, link, 1, Xs) ->
+  strict(arg_types(erlang, link, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, list_to_atom, 1, Xs) ->
+  strict(arg_types(erlang, list_to_atom, 1), Xs, fun (_) -> t_atom() end);
+type(erlang, list_to_binary, 1, Xs) ->
+  strict(arg_types(erlang, list_to_binary, 1), Xs,
+	 fun (_) -> t_binary() end);
+type(erlang, list_to_bitstr, 1, Xs) ->
+  type(erlang, list_to_bitstring, 1, Xs);
+type(erlang, list_to_bitstring, 1, Xs) ->
+  strict(arg_types(erlang, list_to_bitstring, 1), Xs,
+	 fun (_) -> t_bitstr() end);
+type(erlang, list_to_existing_atom, 1, Xs) ->
+  strict(arg_types(erlang, list_to_existing_atom, 1), Xs,
+	 fun (_) -> t_atom() end);
+type(erlang, list_to_float, 1, Xs) ->
+  strict(arg_types(erlang, list_to_float, 1), Xs, fun (_) -> t_float() end);
+type(erlang, list_to_integer, 1, Xs) ->
+  strict(arg_types(erlang, list_to_integer, 1), Xs,
+	 fun (_) -> t_integer() end);
+type(erlang, list_to_pid, 1, Xs) ->
+  strict(arg_types(erlang, list_to_pid, 1), Xs, fun (_) -> t_pid() end);
+type(erlang, list_to_tuple, 1, Xs) ->
+  strict(arg_types(erlang, list_to_tuple, 1), Xs, fun (_) -> t_tuple() end);
+type(erlang, loaded, 0, _) ->
+  t_list(t_atom());
+type(erlang, load_module, 2, Xs) ->
+  strict(arg_types(erlang, load_module, 2), Xs,
+	 fun ([Mod,_Bin]) -> t_code_load_return(Mod) end);
+type(erlang, localtime, 0, Xs) ->
+  type(erlang, universaltime, 0, Xs);    % same
+type(erlang, localtime_to_universaltime, 1, Xs) ->
+  type(erlang, universaltime_to_localtime, 1, Xs);    % same
+type(erlang, localtime_to_universaltime, 2, Xs) ->
+  strict(arg_types(erlang, localtime_to_universaltime, 2), Xs, % typecheck
+	 fun ([X,_]) -> type(erlang, localtime_to_universaltime, 1, [X]) end);
+type(erlang, make_fun, 3, Xs) ->
+  strict(arg_types(erlang, make_fun, 3), Xs, 
+	 fun ([_, _, Arity]) -> 
+	     case t_number_vals(Arity) 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);
+type(erlang, make_ref, 0, _) -> t_reference();
+type(erlang, make_tuple, 2, Xs) ->
+  strict(arg_types(erlang, make_tuple, 2), Xs,
+	 fun ([Int, _]) ->
+	     case t_number_vals(Int) of
+	       [N] when is_integer(N), N >= 0 -> t_tuple(N);
+	       _Other -> t_tuple()
+	     end
+	 end);
+type(erlang, make_tuple, 3, Xs) ->
+  strict(arg_types(erlang, make_tuple, 3), Xs,
+	 fun ([Int, _, _]) ->
+	     case t_number_vals(Int) of
+	       [N] when is_integer(N), N >= 0 -> t_tuple(N);
+	       _Other -> t_tuple()
+	     end
+	 end);
+type(erlang, match_spec_test, 3, Xs) ->
+  strict(arg_types(erlang, match_spec_test, 3), Xs,
+	 fun (_) -> t_sup(t_tuple([t_atom('ok'),
+				   t_any(), % it can be any term
+				   t_list(t_atom('return_trace')),
+				   t_match_spec_test_errors()]),
+			  t_tuple([t_atom('error'),
+				   t_match_spec_test_errors()])) end);
+type(erlang, md5, 1, Xs) ->
+  strict(arg_types(erlang, md5, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, md5_final, 1, Xs) ->
+  strict(arg_types(erlang, md5_final, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, md5_init, 0, _) -> t_binary();
+type(erlang, md5_update, 2, Xs) ->
+  strict(arg_types(erlang, md5_update, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, memory, 0, _) -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
+type(erlang, memory, 1, Xs) ->
+  strict(arg_types(erlang, memory, 1), Xs,
+	 fun ([Type]) ->
+	     case t_is_atom(Type) of
+	       true -> t_non_neg_fixnum();
+	       false ->
+	         case t_is_list(Type) of
+		   true -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
+		   false ->
+		     t_sup(t_non_neg_fixnum(),
+		   	   t_list(t_tuple([t_atom(), t_non_neg_fixnum()])))
+		 end
+	     end
+	 end);
+type(erlang, module_loaded, 1, Xs) ->
+  strict(arg_types(erlang, module_loaded, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, monitor, 2, Xs) ->
+  strict(arg_types(erlang, monitor, 2), Xs, fun (_) -> t_reference() end);
+type(erlang, monitor_node, 2, Xs) ->
+  strict(arg_types(erlang, monitor_node, 2), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, monitor_node, 3, Xs) ->
+  strict(arg_types(erlang, monitor_node, 3), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, node, 0, _) -> t_node();
+type(erlang, node, 1, Xs) ->
+  strict(arg_types(erlang, node, 1), Xs, fun (_) -> t_node() end);
+type(erlang, nodes, 0, _) -> t_list(t_node());
+type(erlang, nodes, 1, Xs) ->
+  strict(arg_types(erlang, nodes, 1), Xs, fun (_) -> t_list(t_node()) end);
+type(erlang, now, 0, _) ->
+  t_time();
+type(erlang, open_port, 2, Xs) ->
+  strict(arg_types(erlang, open_port, 2), Xs, fun (_) -> t_port() end);
+type(erlang, phash, 2, Xs) ->
+  strict(arg_types(erlang, phash, 2), Xs, fun (_) -> t_pos_integer() end);
+type(erlang, phash2, 1, Xs) ->
+  strict(arg_types(erlang, phash2, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, phash2, 2, Xs) ->
+  strict(arg_types(erlang, phash2, 2), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, pid_to_list, 1, Xs) ->
+  strict(arg_types(erlang, pid_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, port_call, 3, Xs) ->
+  strict(arg_types(erlang, port_call, 3), Xs, fun (_) -> t_any() end);
+type(erlang, port_close, 1, Xs) ->
+  strict(arg_types(erlang, port_close, 1), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, port_command, 2, Xs) ->
+  strict(arg_types(erlang, port_command, 2), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, port_command, 3, Xs) ->
+  strict(arg_types(erlang, port_command, 3), Xs,
+	 fun (_) -> t_boolean() end);
+type(erlang, port_connect, 2, Xs) ->
+  strict(arg_types(erlang, port_connect, 2), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, port_control, 3, Xs) ->
+  strict(arg_types(erlang, port_control, 3), Xs,
+	 fun (_) -> t_sup(t_string(), t_binary()) end);
+type(erlang, port_get_data, 1, Xs) ->
+  strict(arg_types(erlang, port_get_data, 1), Xs, fun (_) -> t_any() end);
+type(erlang, port_info, 1, Xs) ->
+  strict(arg_types(erlang, port_info, 1), Xs,
+	 fun (_) -> t_sup(t_atom('undefined'), t_list()) end);
+type(erlang, port_info, 2, Xs) ->
+  strict(arg_types(erlang, port_info, 2), Xs,
+	 fun ([_Port, Item]) ->
+	     t_sup(t_atom('undefined'),
+		   case t_atom_vals(Item) of
+		     ['connected'] -> t_tuple([Item, t_pid()]);
+		     ['id'] -> t_tuple([Item, t_integer()]);
+		     ['input'] -> t_tuple([Item, t_integer()]);
+		     ['links'] -> t_tuple([Item, t_list(t_pid())]);
+		     ['name'] -> t_tuple([Item, t_string()]);
+		     ['output'] -> t_tuple([Item, t_integer()]);
+		     ['registered_name'] -> t_tuple([Item, t_atom()]);
+		     List when is_list(List) ->
+		       t_tuple([t_sup([t_atom(A) || A <- List]),
+				t_sup([t_atom(), t_integer(),
+				       t_pid(), t_list(t_pid()),
+				       t_string()])]);
+		     unknown ->
+		       [_, PosItem] = arg_types(erlang, port_info, 2),
+		       t_tuple([PosItem,
+				t_sup([t_atom(), t_integer(),
+				       t_pid(), t_list(t_pid()),
+				       t_string()])])		       
+		   end)
+	 end);
+type(erlang, port_to_list, 1, Xs) ->
+  strict(arg_types(erlang, port_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, ports, 0, _) -> t_list(t_port());
+type(erlang, port_set_data, 2, Xs) ->
+  strict(arg_types(erlang, port_set_data, 2), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, pre_loaded, 0, _) -> t_list(t_atom());
+type(erlang, process_display, 2, _) -> t_atom('true');
+type(erlang, process_flag, 2, Xs) ->
+  T_process_flag_returns = t_sup([t_boolean(), t_atom(), t_non_neg_integer()]),
+  strict(arg_types(erlang, process_flag, 2), Xs,
+	 fun ([Flag, _Option]) ->
+	     case t_is_atom(Flag) of
+	       true ->
+		 case t_atom_vals(Flag) of
+		   ['error_handler'] -> t_atom();
+		   ['min_heap_size'] -> t_non_neg_integer();
+		   ['monitor_nodes'] -> t_boolean();
+		   ['priority'] -> t_process_priority_level();
+		   ['save_calls'] -> t_non_neg_integer();
+		   ['trap_exit'] -> t_boolean();
+		   List when is_list(List) ->
+		     T_process_flag_returns;
+		   unknown ->
+		     T_process_flag_returns
+		 end;
+	       false -> % XXX: over-approximation if Flag is tuple
+		 T_process_flag_returns
+	     end
+	 end);
+type(erlang, process_flag, 3, Xs) ->
+  strict(arg_types(erlang, process_flag, 3), Xs,
+	 fun (_) -> t_non_neg_integer() end);
+type(erlang, process_info, 1, Xs) ->
+  strict(arg_types(erlang, process_info, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_list(t_tuple([t_pinfo(), t_any()])),
+		   t_atom('undefined'))
+	 end);
+type(erlang, process_info, 2, Xs) ->
+  %% we define all normal return values: the return when the process exists
+  %% t_nil() is the return for 'registered_name'; perhaps for more
+  T_process_info_2_normal_returns =
+    t_sup([t_tuple([t_pinfo_item(), t_any()]), t_nil()]),
+  strict(arg_types(erlang, process_info, 2), Xs,
+	 fun ([_Pid, InfoItem]) ->
+	     Ret = case t_is_atom(InfoItem) of
+		     true ->
+		       case t_atom_vals(InfoItem) of
+			 ['backtrace'] -> t_tuple([InfoItem, t_binary()]);
+			 ['current_function'] -> t_tuple([InfoItem, t_mfa()]);
+			 ['dictionary'] -> t_tuple([InfoItem, t_list()]);
+			 ['error_handler'] -> t_tuple([InfoItem, t_atom()]);
+			 ['garbage_collection'] ->
+			   t_tuple([InfoItem, t_list()]);
+			 ['group_leader'] -> t_tuple([InfoItem, t_pid()]);
+			 ['heap_size'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['initial_call'] -> t_tuple([InfoItem, t_mfa()]);
+			 ['last_calls'] ->
+			   t_tuple([InfoItem,
+				    t_sup(t_atom('false'), t_list())]);
+			 ['links'] -> t_tuple([InfoItem, t_list(t_pid())]);
+			 ['memory'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['message_binary'] -> t_tuple([InfoItem,  t_list()]);
+			 ['message_queue_len'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['messages'] -> t_tuple([InfoItem, t_list()]);
+			 ['monitored_by'] ->
+			   t_tuple([InfoItem,  t_list(t_pid())]);
+			 ['monitors'] ->
+			   t_tuple([InfoItem, 
+				    t_list(t_sup(t_tuple([t_atom('process'),
+							  t_pid()]),
+						 t_tuple([t_atom('process'),
+							  t_tuple([t_atom(),
+								   t_atom()])])))]);
+			 ['priority'] ->
+			   t_tuple([InfoItem, t_process_priority_level()]);
+			 ['reductions'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['registered_name'] ->
+			   t_sup(t_tuple([InfoItem, t_atom()]), t_nil());
+			 ['sequential_trace_token'] ->
+			   t_tuple([InfoItem, t_any()]); %% Underspecified
+			 ['stack_size'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['status'] ->
+			   t_tuple([InfoItem, t_process_status()]);
+			 ['suspending'] ->
+			   t_tuple([InfoItem,
+				    t_list(t_tuple([t_pid(),
+						    t_non_neg_integer(),
+						    t_non_neg_integer()]))]);
+			 ['total_heap_size'] ->
+			   t_tuple([InfoItem, t_non_neg_integer()]);
+			 ['trap_exit'] ->
+			   t_tuple([InfoItem, t_boolean()]);
+			 List when is_list(List) ->
+			   T_process_info_2_normal_returns;
+			 unknown ->
+			   T_process_info_2_normal_returns
+		       end;
+		     false ->
+		       case t_is_list(InfoItem) of
+			 true ->
+			   t_list(t_tuple([t_pinfo_item(), t_any()]));
+			 false ->
+			   t_sup(T_process_info_2_normal_returns,
+				 t_list(t_tuple([t_pinfo_item(), t_any()])))
+		       end
+		   end,
+	       t_sup([Ret, t_atom('undefined')])
+	 end);
+type(erlang, processes, 0, _) -> t_list(t_pid());
+type(erlang, purge_module, 1, Xs) ->
+  strict(arg_types(erlang, purge_module, 1), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, put, 2, Xs) ->
+  strict(arg_types(erlang, put, 2), Xs, fun (_) -> t_any() end);
+type(erlang, raise, 3, _) -> t_none();
+type(erlang, read_timer, 1, Xs) ->
+  strict(arg_types(erlang, read_timer, 1), Xs,
+	 fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(erlang, ref_to_list, 1, Xs) ->
+  strict(arg_types(erlang, ref_to_list, 1), Xs, fun (_) -> t_string() end);
+type(erlang, register, 2, Xs) ->
+  strict(arg_types(erlang, register, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, registered, 0, _) -> t_list(t_atom());
+type(erlang, resume_process, 1, Xs) ->
+  strict(arg_types(erlang, resume_process, 1), Xs,
+	 fun (_) -> t_any() end); %% TODO: overapproximation -- fix this
+type(erlang, round, 1, Xs) ->
+  strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, self, 0, _) -> t_pid();
+type(erlang, send, 2, Xs) -> type(erlang, '!', 2, Xs);  % alias
+type(erlang, send, 3, Xs) ->
+  strict(arg_types(erlang, send, 3), Xs,
+	 fun (_) -> t_sup(t_atom('ok'), t_sendoptions()) end);
+type(erlang, send_after, 3, Xs) ->
+  strict(arg_types(erlang, send_after, 3), Xs, fun (_) -> t_reference() end);
+type(erlang, seq_trace, 2, Xs) ->
+  strict(arg_types(erlang, seq_trace, 2), Xs,
+	 fun (_) -> t_sup(t_seq_trace_info_returns(), t_tuple(5)) end);
+type(erlang, seq_trace_info, 1, Xs) ->
+  strict(arg_types(erlang, seq_trace_info, 1), Xs,
+	 fun ([Item]) ->
+	     case t_atom_vals(Item) of
+	       ['label'] ->
+		 t_sup(t_tuple([Item, t_non_neg_integer()]), t_nil());
+	       ['serial'] -> 
+		 t_sup(t_tuple([Item, t_tuple([t_non_neg_integer(),
+					       t_non_neg_integer()])]),
+		       t_nil());
+	       ['send'] -> t_tuple([Item, t_boolean()]);
+	       ['receive'] -> t_tuple([Item, t_boolean()]);
+	       ['print'] -> t_tuple([Item, t_boolean()]);
+	       ['timestamp'] -> t_tuple([Item, t_boolean()]);
+	       List when is_list(List) ->
+		 t_seq_trace_info_returns();
+	       unknown ->
+		 t_seq_trace_info_returns()
+	     end
+	 end);
+type(erlang, seq_trace_print, 1, Xs) ->
+  strict(arg_types(erlang, seq_trace_print, 1), Xs, fun (_) -> t_boolean() end);
+type(erlang, seq_trace_print, 2, Xs) ->
+  strict(arg_types(erlang, seq_trace_print, 2), Xs, fun (_) -> t_boolean() end);
+type(erlang, set_cookie, 2, Xs) ->
+  strict(arg_types(erlang, set_cookie, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, setelement, 3, Xs) ->
+  strict(arg_types(erlang, setelement, 3), Xs,
+	 fun ([X1, X2, X3]) ->
+	     case t_tuple_subtypes(X2) of
+	       unknown -> t_tuple();
+	       [_] ->
+		 Sz = t_tuple_size(X2),
+		 As = t_tuple_args(X2),
+		 case t_number_vals(X1) of
+		   unknown ->
+		     t_tuple([t_sup(X, X3) || X <- As]);
+		   [N] when is_integer(N), 1 =< N, N =< Sz ->
+		     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);
+type(erlang, setnode, 2, Xs) ->
+  strict(arg_types(erlang, setnode, 2), Xs, fun (_) -> t_atom('true') end);
+type(erlang, setnode, 3, Xs) ->
+  strict(arg_types(erlang, setnode, 3), Xs, fun (_) -> t_atom('true') end);
+type(erlang, size, 1, Xs) ->
+  strict(arg_types(erlang, size, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, spawn, 1, Xs) ->
+  strict(arg_types(erlang, spawn, 1), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 2, Xs) ->
+  strict(arg_types(erlang, spawn, 2), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 3, Xs) ->
+  strict(arg_types(erlang, spawn, 3), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn, 4, Xs) ->
+  strict(arg_types(erlang, spawn, 4), Xs, fun (_) -> t_pid() end);
+type(erlang, spawn_link, 1, Xs) -> type(erlang, spawn, 1, Xs);  % same
+type(erlang, spawn_link, 2, Xs) -> type(erlang, spawn, 2, Xs);  % same
+type(erlang, spawn_link, 3, Xs) -> type(erlang, spawn, 3, Xs);  % same
+type(erlang, spawn_link, 4, Xs) -> type(erlang, spawn, 4, Xs);  % same
+type(erlang, spawn_opt, 1, Xs) ->
+  strict(arg_types(erlang, spawn_opt, 1), Xs, 
+	 fun ([Tuple]) ->
+	     Fun = fun (TS) ->
+		       [_, _, _, List] = t_tuple_args(TS),
+		       t_spawn_opt_return(List)
+		   end,
+	     t_sup([Fun(TS) || TS <- t_tuple_subtypes(Tuple)])
+	 end);
+type(erlang, spawn_opt, 2, Xs) -> 
+  strict(arg_types(erlang, spawn_opt, 2), Xs, 
+	 fun ([_, List]) -> t_spawn_opt_return(List) end);
+type(erlang, spawn_opt, 3, Xs) -> 
+  strict(arg_types(erlang, spawn_opt, 3), Xs, 
+	 fun ([_, _, List]) -> t_spawn_opt_return(List) end);
+type(erlang, spawn_opt, 4, Xs) -> 
+  strict(arg_types(erlang, spawn_opt, 4), Xs, 
+	 fun ([_, _, _, List]) -> t_spawn_opt_return(List) end);
+type(erlang, split_binary, 2, Xs) ->
+  strict(arg_types(erlang, split_binary, 2), Xs,
+	 fun (_) -> t_tuple([t_binary(), t_binary()]) end);
+type(erlang, start_timer, 3, Xs) ->
+  strict(arg_types(erlang, start_timer, 3), Xs, fun (_) -> t_reference() end);
+type(erlang, statistics, 1, Xs) ->
+  strict(arg_types(erlang, statistics, 1), Xs,
+	 fun ([Type]) ->
+	     T_statistics_1 = t_sup([t_non_neg_integer(),
+				     t_tuple([t_non_neg_integer(),
+					      t_non_neg_integer()]),
+				     %% When called with the argument 'io'.
+				     t_tuple([t_tuple([t_atom('input'),
+						       t_non_neg_integer()]),
+					      t_tuple([t_atom('output'),
+						       t_non_neg_integer()])]),
+				     t_tuple([t_non_neg_integer(),
+					      t_non_neg_integer(),
+					      t_non_neg_integer()])]),
+	     case t_atom_vals(Type) of
+	       ['context_switches'] ->
+		 t_tuple([t_non_neg_integer(), t_integer(0)]);
+	       ['exact_reductions'] ->
+		 t_tuple([t_non_neg_integer(), t_non_neg_integer()]);
+	       ['garbage_collection'] ->
+		 t_tuple([t_non_neg_integer(),
+			  t_non_neg_integer(),
+			  t_integer(0)]);
+	       ['io'] ->
+		 t_tuple([t_tuple([t_atom('input'),  t_non_neg_integer()]),
+			  t_tuple([t_atom('output'), t_non_neg_integer()])]);
+	       ['reductions'] ->
+		 t_tuple([t_non_neg_integer(), t_non_neg_integer()]);
+	       ['run_queue'] ->
+		 t_non_neg_integer();
+	       ['runtime'] ->
+		 t_tuple([t_non_neg_integer(), t_integer(0)]);
+	       ['wall_clock'] ->
+		 t_tuple([t_non_neg_integer(), t_integer(0)]);
+	       List when is_list(List) ->
+		 T_statistics_1;
+	       unknown ->
+		 T_statistics_1
+	     end
+	 end);
+type(erlang, suspend_process, 1, Xs) ->
+  strict(arg_types(erlang, suspend_process, 1), Xs,
+	 fun (_) -> t_atom('true') end);
+type(erlang, suspend_process, 2, Xs) ->
+  strict(arg_types(erlang, suspend_process, 2), Xs,
+	 fun (_) -> t_boolean() end);
+type(erlang, system_flag, 2, Xs) ->
+  strict(arg_types(erlang, system_flag, 2), Xs,
+	 fun ([Flag,_Value]) ->
+	     %% this provides an overapproximation of all return values 
+	     T_system_flag_2 = t_sup([t_boolean(),
+				      t_integer(),
+				      t_sequential_tracer(),
+				      t_system_cpu_topology(),
+				      t_system_multi_scheduling()]),
+	     case t_is_atom(Flag) of
+	       true ->
+	         case t_atom_vals(Flag) of
+		   ['backtrace_depth'] ->
+		     t_non_neg_fixnum();
+		   ['cpu_topology'] ->
+		     t_system_cpu_topology();
+		   ['debug_flags'] ->
+		     t_atom('true');
+		   ['display_items'] ->
+		     t_non_neg_fixnum();
+		   ['fullsweep_after'] ->
+		     t_non_neg_fixnum();
+		   ['min_heap_size'] ->
+		     t_non_neg_fixnum();
+		   ['multi_scheduling'] ->
+		     t_system_multi_scheduling();
+		   ['schedulers_online'] ->
+		     t_pos_fixnum();
+		   ['scheduler_bind_type'] ->
+		     t_scheduler_bind_type_results();
+		   ['sequential_tracer'] ->
+		     t_sequential_tracer();
+		   ['trace_control_word'] ->
+		     t_integer();
+		   List when is_list(List) ->
+		     T_system_flag_2;
+		   unknown ->
+		     T_system_flag_2
+		 end;
+	       false ->
+	       	 case t_is_integer(Flag) of	% SHOULD BE: t_is_fixnum
+		   true ->
+		     t_atom('true');
+		   false ->
+		     T_system_flag_2
+		 end
+	     end
+	 end);
+type(erlang, system_info, 1, Xs) ->
+  strict(arg_types(erlang, system_info, 1), Xs,
+	 fun ([Type]) ->
+	     case t_is_atom(Type) of
+	       true ->
+		 case t_atom_vals(Type) 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('elib_malloc'),
+				     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])]));
+		   ['elib_malloc'] ->
+		     t_sup([t_atom('false'),
+			    t_list(t_tuple([t_atom(), t_any()]))]);
+		   ['endian'] ->
+		     t_sup([t_atom('big'), t_atom('little')]);
+		   ['fullsweep_after'] ->
+		     t_tuple([t_atom('fullsweep_after'), t_non_neg_integer()]);
+		   ['garbage_collection'] ->
+		     t_list();
+		   ['global_heaps_size'] ->
+		     t_non_neg_integer();
+		   ['heap_sizes'] ->
+		     t_list(t_integer());
+		   ['heap_type'] ->
+		     t_sup([t_atom('private'), t_atom('hybrid')]);
+		   ['hipe_architecture'] ->
+		     t_sup([t_atom('amd64'), t_atom('arm'),
+			    t_atom('powerpc'), t_atom('undefined'),
+			    t_atom('ultrasparc'), t_atom('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('ose'),	% XXX: undocumented
+				     t_atom('unix'),
+				     t_atom('vxworks'),
+				     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());
+		   ['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);
+type(erlang, system_monitor, 0, Xs) ->
+  strict(arg_types(erlang, system_monitor, 0), Xs,
+	 fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_monitor, 1, Xs) ->
+  strict(arg_types(erlang, system_monitor, 1), Xs,
+	 fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_monitor, 2, Xs) ->
+  strict(arg_types(erlang, system_monitor, 2), Xs,
+	 fun (_) -> t_system_monitor_settings() end);
+type(erlang, system_profile, 0, _) ->
+  t_system_profile_return();
+type(erlang, system_profile, 2, Xs) ->
+  strict(arg_types(erlang, system_profile, 2), Xs,
+	 fun (_) -> t_system_profile_return() end); 
+type(erlang, term_to_binary, 1, Xs) ->
+  strict(arg_types(erlang, term_to_binary, 1), Xs, fun (_) -> t_binary() end);
+type(erlang, term_to_binary, 2, Xs) ->
+  strict(arg_types(erlang, term_to_binary, 2), Xs, fun (_) -> t_binary() end);
+type(erlang, time, 0, _) ->
+  t_tuple([t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer()]);
+type(erlang, tl, 1, Xs) ->
+  strict(arg_types(erlang, tl, 1), Xs, fun ([X]) -> t_cons_tl(X) end);
+type(erlang, trace, 3, Xs) ->
+  strict(arg_types(erlang, trace, 3), Xs, fun (_) -> t_integer() end);
+type(erlang, trace_delivered, 1, Xs) ->
+  strict(arg_types(erlang, trace_delivered, 1), Xs,
+	 fun (_) -> t_reference() end);
+type(erlang, trace_info, 2, Xs) ->
+  strict(arg_types(erlang, trace_info, 2), Xs,
+	 fun (_) ->
+	     t_tuple([t_atom(),
+		      t_sup([%% the following is info about a PID
+			     t_list(t_atom()), t_pid(), t_port(),
+			     %% the following is info about a func
+			     t_atom('global'), t_atom('local'),
+			     t_atom('false'), t_atom('true'),
+			     t_list(), t_pid(), t_port(),
+			     t_integer(),
+			     t_list(t_tuple([t_atom(), t_any()])),
+			     %% and this is the 'not found' value
+			     t_atom('undefined')])])
+	 end);
+type(erlang, trace_pattern, 2, Xs) ->
+  strict(arg_types(erlang, trace_pattern, 2), Xs,
+	 fun (_) -> t_non_neg_fixnum() end); %% num of MFAs that match pattern
+type(erlang, trace_pattern, 3, Xs) ->
+  strict(arg_types(erlang, trace_pattern, 3), Xs,
+	 fun (_) -> t_non_neg_fixnum() end); %% num of MFAs that match pattern
+type(erlang, trunc, 1, Xs) ->
+  strict(arg_types(erlang, trunc, 1), Xs, fun (_) -> t_integer() end);
+type(erlang, tuple_size, 1, Xs) ->
+  strict(arg_types(erlang, tuple_size, 1), Xs, fun (_) -> t_non_neg_integer() end);
+type(erlang, tuple_to_list, 1, Xs) ->
+  strict(arg_types(erlang, tuple_to_list, 1), Xs,
+	 fun ([X]) ->
+	     case t_tuple_subtypes(X) of
+	       unknown -> t_list();
+	       SubTypes -> 
+		 Args = lists:flatten([t_tuple_args(ST) || ST <- SubTypes]),
+		 %% Can be nil if the tuple can be {}
+		 case lists:any(fun (T) ->
+				    t_tuple_size(T) =:= 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);
+type(erlang, universaltime, 0, _) ->
+  t_tuple([t_date(), t_time()]);
+type(erlang, universaltime_to_localtime, 1, Xs) ->
+  strict(arg_types(erlang, universaltime_to_localtime, 1), Xs,
+	 fun ([T]) -> T end);
+type(erlang, unlink, 1, Xs) ->
+  strict(arg_types(erlang, unlink, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, unregister, 1, Xs) ->
+  strict(arg_types(erlang, unregister, 1), Xs, fun (_) -> t_atom('true') end);
+type(erlang, whereis, 1, Xs) ->
+  strict(arg_types(erlang, whereis, 1), Xs,
+	 fun (_) -> t_sup([t_pid(), t_port(), t_atom('undefined')]) end);
+type(erlang, yield, 0, _) -> t_atom('true');
+%%-- erl_prim_loader ----------------------------------------------------------
+type(erl_prim_loader, get_file, 1, Xs) ->
+  strict(arg_types(erl_prim_loader, get_file, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_binary(), t_string()]),
+		   t_atom('error'))
+	 end);
+type(erl_prim_loader, get_path, 0, _) ->
+  t_tuple([t_atom('ok'), t_list(t_string())]);
+type(erl_prim_loader, set_path, 1, Xs) ->
+  strict(arg_types(erl_prim_loader, set_path, 1), Xs,
+	 fun (_) -> t_atom('ok') end);
+%%-- error_logger -------------------------------------------------------------
+type(error_logger, warning_map, 0, _) ->
+  t_sup([t_atom('info'), t_atom('warning'), t_atom('error')]);
+%%-- erts_debug ---------------------------------------------------------------
+type(erts_debug, breakpoint, 2, Xs) ->
+  strict(arg_types(erts_debug, breakpoint, 2), Xs, fun (_) -> t_fixnum() end);
+type(erts_debug, disassemble, 1, Xs) ->
+  strict(arg_types(erts_debug, disassemble, 1), Xs,
+	 fun (_) -> t_sup([t_atom('false'),
+			   t_atom('undef'),
+			   t_tuple([t_integer(), t_binary(), t_mfa()])]) end);
+type(erts_debug, flat_size, 1, Xs) ->
+  strict(arg_types(erts_debug, flat_size, 1), Xs, fun (_) -> t_integer() end);
+type(erts_debug, same, 2, Xs) ->
+  strict(arg_types(erts_debug, same, 2), Xs, fun (_) -> t_boolean() end);
+%%-- ets ----------------------------------------------------------------------
+type(ets, all, 0, _) ->
+  t_list(t_tab());
+type(ets, delete, 1, Xs) ->
+  strict(arg_types(ets, delete, 1), Xs, fun (_) -> t_atom('true') end);
+type(ets, delete, 2, Xs) ->
+  strict(arg_types(ets, delete, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, delete_all_objects, 1, Xs) ->
+  strict(arg_types(ets, delete_all_objects, 1), Xs,
+	 fun (_) -> t_atom('true') end);
+type(ets, delete_object, 2, Xs) ->
+  strict(arg_types(ets, delete_object, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, first, 1, Xs) ->
+  strict(arg_types(ets, first, 1), Xs, fun (_) -> t_any() end);
+type(ets, give_away, 3, Xs) ->
+  strict(arg_types(ets, give_away, 3), Xs, fun (_) -> t_atom('true') end);
+type(ets, info, 1, Xs) ->
+  strict(arg_types(ets, info, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_list(t_tuple([t_ets_info_items(), t_any()])),
+		   t_atom('undefined'))
+	 end);
+type(ets, info, 2, Xs) ->
+  strict(arg_types(ets, info, 2), Xs, fun (_) -> t_any() end);
+type(ets, insert, 2, Xs) ->
+  strict(arg_types(ets, insert, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, insert_new, 2, Xs) ->
+  strict(arg_types(ets, insert_new, 2), Xs, fun (_) -> t_boolean() end);
+type(ets, is_compiled_ms, 1, Xs) ->
+  strict(arg_types(ets, is_compiled_ms, 1), Xs, fun (_) -> t_boolean() end);
+type(ets, last, 1, Xs) ->
+  type(ets, first, 1, Xs);
+type(ets, lookup, 2, Xs) ->
+  strict(arg_types(ets, lookup, 2), Xs, fun (_) -> t_list(t_tuple()) end);
+type(ets, lookup_element, 3, Xs) ->
+  strict(arg_types(ets, lookup_element, 3), Xs, fun (_) -> t_any() end);
+type(ets, match, 1, Xs) ->
+  strict(arg_types(ets, match, 1), Xs, fun (_) -> t_matchres() end);
+type(ets, match, 2, Xs) ->
+  strict(arg_types(ets, match, 2), Xs, fun (_) -> t_list() end);
+type(ets, match, 3, Xs) ->
+  strict(arg_types(ets, match, 3), Xs, fun (_) -> t_matchres() end);
+type(ets, match_object, 1, Xs) -> type(ets, match, 1, Xs);
+type(ets, match_object, 2, Xs) -> type(ets, match, 2, Xs);
+type(ets, match_object, 3, Xs) -> type(ets, match, 3, Xs);
+type(ets, match_spec_compile, 1, Xs) ->
+  strict(arg_types(ets, match_spec_compile, 1), Xs, fun (_) -> t_any() end);
+type(ets, match_spec_run_r, 3, Xs) ->
+  strict(arg_types(ets, match_spec_run_r, 3), Xs, fun (_) -> t_list() end);
+type(ets, member, 2, Xs) ->
+  strict(arg_types(ets, member, 2), Xs, fun (_) -> t_boolean() end);
+type(ets, new, 2, Xs) ->
+  strict(arg_types(ets, new, 2), Xs, fun (_) -> t_tab() end);
+type(ets, next, 2, Xs) ->
+  strict(arg_types(ets, next, 2), Xs,
+	 %% t_any below stands for:  term() | '$end_of_table'
+	 fun (_) -> t_any() end);
+type(ets, prev, 2, Xs) -> type(ets, next, 2, Xs);
+type(ets, rename, 2, Xs) ->
+  strict(arg_types(ets, rename, 2), Xs, fun ([_, Name]) -> Name end);
+type(ets, safe_fixtable, 2, Xs) ->
+  strict(arg_types(ets, safe_fixtable, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, select, 1, Xs) ->
+  strict(arg_types(ets, select, 1), Xs, fun (_) -> t_matchres() end);
+type(ets, select, 2, Xs) ->
+  strict(arg_types(ets, select, 2), Xs, fun (_) -> t_list() end);
+type(ets, select, 3, Xs) ->
+  strict(arg_types(ets, select, 3), Xs, fun (_) -> t_matchres() end);
+type(ets, select_count, 2, Xs) ->
+  strict(arg_types(ets, select_count, 2), Xs,
+	 fun (_) -> t_non_neg_fixnum() end);
+type(ets, select_delete, 2, Xs) ->
+  strict(arg_types(ets, select_delete, 2), Xs,
+	 fun (_) -> t_non_neg_fixnum() end);
+type(ets, select_reverse, 1, Xs) -> type(ets, select, 1, Xs);
+type(ets, select_reverse, 2, Xs) -> type(ets, select, 2, Xs);
+type(ets, select_reverse, 3, Xs) -> type(ets, select, 3, Xs);
+type(ets, setopts, 2, Xs) ->
+  strict(arg_types(ets, setopts, 2), Xs, fun (_) -> t_atom('true') end);
+type(ets, slot, 2, Xs) ->
+  strict(arg_types(ets, slot, 2), Xs,
+	 fun (_) -> t_sup(t_list(t_tuple()), t_atom('$end_of_table')) end);
+type(ets, update_counter, 3, Xs) ->
+  strict(arg_types(ets, update_counter, 3), Xs, fun (_) -> t_integer() end);
+type(ets, update_element, 3, Xs) ->
+  strict(arg_types(ets, update_element, 3), Xs, fun (_) -> t_boolean() end);
+%%-- file ---------------------------------------------------------------------
+type(file, close, 1, Xs) ->
+  strict(arg_types(file, close, 1), Xs, fun (_) -> t_file_return() end);
+type(file, delete, 1, Xs) ->
+  strict(arg_types(file, delete, 1), Xs, fun (_) -> t_file_return() end);
+type(file, get_cwd, 0, _) ->
+  t_sup(t_tuple([t_atom('ok'), t_string()]),
+	t_tuple([t_atom('error'), t_file_posix_error()]));
+type(file, make_dir, 1, Xs) ->
+  strict(arg_types(file, make_dir, 1), Xs, fun (_) -> t_file_return() end);
+type(file, open, 2, Xs) ->
+  strict(arg_types(file, open, 2), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('ok'), t_file_io_device()]),
+		    t_tuple([t_atom('error'), t_file_posix_error()])])
+	 end);
+type(file, read_file, 1, Xs) ->
+  strict(arg_types(file, read_file, 1), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('ok'), t_binary()]),
+		    t_tuple([t_atom('error'), t_file_posix_error()])])
+	 end);
+type(file, set_cwd, 1, Xs) ->
+  strict(arg_types(file, set_cwd, 1), Xs, 
+	 fun (_) -> t_sup(t_atom('ok'),
+			  t_tuple([t_atom('error'), t_file_posix_error()]))
+	 end);
+type(file, write_file, 2, Xs) ->
+  strict(arg_types(file, write_file, 2), Xs, fun (_) -> t_file_return() end);
+%%-- gen_tcp ------------------------------------------------------------------
+%% NOTE: All type information for this module added to avoid loss of precision
+type(gen_tcp, accept, 1, Xs) ->
+  strict(arg_types(gen_tcp, accept, 1), Xs, fun (_) -> t_gen_tcp_accept() end);
+type(gen_tcp, accept, 2, Xs) ->
+  strict(arg_types(gen_tcp, accept, 2), Xs, fun (_) -> t_gen_tcp_accept() end);
+type(gen_tcp, connect, 3, Xs) ->
+  strict(arg_types(gen_tcp, connect, 3), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_socket()]),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_tcp, connect, 4, Xs) ->
+  strict(arg_types(gen_tcp, connect, 4), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_socket()]),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_tcp, listen, 2, Xs) ->
+  strict(arg_types(gen_tcp, listen, 2), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_socket()]),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_tcp, recv, 2, Xs) ->
+  strict(arg_types(gen_tcp, recv, 2), Xs, fun (_) -> t_gen_tcp_recv() end);
+type(gen_tcp, recv, 3, Xs) ->
+  strict(arg_types(gen_tcp, recv, 3), Xs, fun (_) -> t_gen_tcp_recv() end);
+type(gen_tcp, send, 2, Xs) ->
+  strict(arg_types(gen_tcp, send, 2), Xs,
+	 fun (_) ->
+	     t_sup(t_atom('ok'),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_tcp, shutdown, 2, Xs) ->
+  strict(arg_types(gen_tcp, shutdown, 2), Xs,
+	 fun (_) ->
+	     t_sup(t_atom('ok'),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+%%-- gen_udp ------------------------------------------------------------------
+%% NOTE: All type information for this module added to avoid loss of precision
+type(gen_udp, open, 1, Xs) ->
+  strict(arg_types(gen_udp, open, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_socket()]),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_udp, open, 2, Xs) ->
+  strict(arg_types(gen_udp, open, 2), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_socket()]),
+		   t_tuple([t_atom('error'), t_inet_posix_error()]))
+	 end);
+type(gen_udp, recv, 2, Xs) ->
+  strict(arg_types(gen_udp, recv, 2), Xs, fun (_) -> t_gen_udp_recv() end);
+type(gen_udp, recv, 3, Xs) ->
+  strict(arg_types(gen_udp, recv, 3), Xs, fun (_) -> t_gen_udp_recv() end);
+type(gen_udp, send, 4, Xs) ->
+  strict(arg_types(gen_udp, send, 4), Xs,
+	 fun (_) ->
+	     t_sup(t_atom('ok'),
+		   t_tuple([t_atom('error'), t_sup(t_atom('not_owner'),
+						   t_inet_posix_error())]))
+	 end);
+%%-- hipe_bifs ----------------------------------------------------------------
+type(hipe_bifs, add_ref, 2, Xs) ->
+  strict(arg_types(hipe_bifs, add_ref, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, alloc_data, 2, Xs) ->
+  strict(arg_types(hipe_bifs, alloc_data, 2), Xs,
+	 fun (_) -> t_integer() end); % address
+type(hipe_bifs, array, 2, Xs) ->
+  strict(arg_types(hipe_bifs, array, 2), Xs, fun (_) -> t_immarray() end);
+type(hipe_bifs, array_length, 1, Xs) ->
+  strict(arg_types(hipe_bifs, array_length, 1), Xs,
+	 fun (_) -> t_non_neg_fixnum() end);
+type(hipe_bifs, array_sub, 2, Xs) ->
+  strict(arg_types(hipe_bifs, array_sub, 2), Xs, fun (_) -> t_immediate() end);
+type(hipe_bifs, array_update, 3, Xs) ->
+  strict(arg_types(hipe_bifs, array_update, 3), Xs,
+	 fun (_) -> t_immarray() end);
+type(hipe_bifs, atom_to_word, 1, Xs) ->
+  strict(arg_types(hipe_bifs, atom_to_word, 1), Xs,
+	 fun (_) -> t_integer() end);
+type(hipe_bifs, bif_address, 3, Xs) ->
+  strict(arg_types(hipe_bifs, bif_address, 3), Xs,
+	 fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(hipe_bifs, bitarray, 2, Xs) ->
+  strict(arg_types(hipe_bifs, bitarray, 2), Xs, fun (_) -> t_bitarray() end);
+type(hipe_bifs, bitarray_sub, 2, Xs) ->
+  strict(arg_types(hipe_bifs, bitarray_sub, 2), Xs, fun (_) -> t_boolean() end);
+type(hipe_bifs, bitarray_update, 3, Xs) ->
+  strict(arg_types(hipe_bifs, bitarray_update, 3), Xs,
+	 fun (_) -> t_bitarray() end);
+type(hipe_bifs, bytearray, 2, Xs) ->
+  strict(arg_types(hipe_bifs, bytearray, 2), Xs, fun (_) -> t_bytearray() end);
+type(hipe_bifs, bytearray_sub, 2, Xs) ->
+  strict(arg_types(hipe_bifs, bytearray_sub, 2), Xs, fun (_) -> t_byte() end);
+type(hipe_bifs, bytearray_update, 3, Xs) ->
+  strict(arg_types(hipe_bifs, bytearray_update, 3), Xs,
+	 fun (_) -> t_bytearray() end);
+type(hipe_bifs, call_count_clear, 1, Xs) ->
+  strict(arg_types(hipe_bifs, call_count_clear, 1), Xs,
+	 fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_get, 1, Xs) ->
+  strict(arg_types(hipe_bifs, call_count_get, 1), Xs,
+	 fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_off, 1, Xs) ->
+  strict(arg_types(hipe_bifs, call_count_off, 1), Xs,
+	 fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end);
+type(hipe_bifs, call_count_on, 1, Xs) ->
+  strict(arg_types(hipe_bifs, call_count_on, 1), Xs,
+	 fun (_) -> t_sup(t_atom('true'), t_nil()) end);
+type(hipe_bifs, check_crc, 1, Xs) ->
+  strict(arg_types(hipe_bifs, check_crc, 1), Xs, fun (_) -> t_boolean() end);
+type(hipe_bifs, enter_code, 2, Xs) ->
+  strict(arg_types(hipe_bifs, enter_code, 2), Xs,
+	 fun (_) -> t_tuple([t_integer(),
+			     %% XXX: The tuple below contains integers and
+			     %% is of size same as the length of the MFA list
+			     t_sup(t_nil(), t_binary())]) end);
+type(hipe_bifs, enter_sdesc, 1, Xs) ->
+  strict(arg_types(hipe_bifs, enter_sdesc, 1), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, find_na_or_make_stub, 2, Xs) ->
+  strict(arg_types(hipe_bifs, find_na_or_make_stub, 2), Xs,
+	 fun (_) -> t_integer() end); % address
+type(hipe_bifs, fun_to_address, 1, Xs) ->
+  strict(arg_types(hipe_bifs, fun_to_address, 1), Xs,
+	 fun (_) -> t_integer() end);
+%% type(hipe_bifs, get_emu_address, 1, Xs) ->
+%%    strict(arg_types(hipe_bifs, get_emu_address, 1), Xs,
+%%	   fun (_) -> t_integer() end); % address
+type(hipe_bifs, get_rts_param, 1, Xs) ->
+  strict(arg_types(hipe_bifs, get_rts_param, 1), Xs,
+	 fun (_) -> t_sup(t_integer(), t_nil()) end);
+type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs) ->
+  strict(arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, make_fe, 3, Xs) ->
+  strict(arg_types(hipe_bifs, make_fe, 3), Xs, fun (_) -> t_integer() end);
+%% type(hipe_bifs, make_native_stub, 2, Xs) ->
+%%    strict(arg_types(hipe_bifs, make_native_stub, 2), Xs,
+%%	   fun (_) -> t_integer() end); % address
+type(hipe_bifs, mark_referred_from, 1, Xs) ->
+  strict(arg_types(hipe_bifs, mark_referred_from, 1), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, merge_term, 1, Xs) ->
+  strict(arg_types(hipe_bifs, merge_term, 1), Xs, fun ([X]) -> X end);
+type(hipe_bifs, patch_call, 3, Xs) ->
+  strict(arg_types(hipe_bifs, patch_call, 3), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, patch_insn, 3, Xs) ->
+  strict(arg_types(hipe_bifs, patch_insn, 3), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, primop_address, 1, Xs) ->
+  strict(arg_types(hipe_bifs, primop_address, 1), Xs,
+	 fun (_) -> t_sup(t_integer(), t_atom('false')) end);
+type(hipe_bifs, redirect_referred_from, 1, Xs) ->
+  strict(arg_types(hipe_bifs, redirect_referred_from, 1), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, ref, 1, Xs) ->
+  strict(arg_types(hipe_bifs, ref, 1), Xs, fun (_) -> t_immarray() end);
+type(hipe_bifs, ref_get, 1, Xs) ->
+  strict(arg_types(hipe_bifs, ref_get, 1), Xs, fun (_) -> t_immediate() end);
+type(hipe_bifs, ref_set, 2, Xs) ->
+  strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, remove_refs_from, 1, Xs) ->
+  strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, set_funinfo_native_address, 3, Xs) ->
+  strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, set_native_address, 3, Xs) ->
+  strict(arg_types(hipe_bifs, set_native_address, 3), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, system_crc, 1, Xs) ->
+  strict(arg_types(hipe_bifs, system_crc, 1), Xs, fun (_) -> t_integer() end);
+type(hipe_bifs, term_to_word, 1, Xs) ->
+  strict(arg_types(hipe_bifs, term_to_word, 1), Xs,
+	 fun (_) -> t_integer() end);
+type(hipe_bifs, update_code_size, 3, Xs) ->
+  strict(arg_types(hipe_bifs, update_code_size, 3), Xs,
+	 fun (_) -> t_nil() end);
+type(hipe_bifs, write_u8, 2, Xs) ->
+  strict(arg_types(hipe_bifs, write_u8, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, write_u32, 2, Xs) ->
+  strict(arg_types(hipe_bifs, write_u32, 2), Xs, fun (_) -> t_nil() end);
+type(hipe_bifs, write_u64, 2, Xs) ->
+  strict(arg_types(hipe_bifs, write_u64, 2), Xs, fun (_) -> t_nil() end);
+%%-- io -----------------------------------------------------------------------
+type(io, format, 1, Xs) ->
+  strict(arg_types(io, format, 1), Xs, fun (_) -> t_atom('ok') end);
+type(io, format, 2, Xs) ->
+  strict(arg_types(io, format, 2), Xs, fun (_) -> t_atom('ok') end);
+type(io, format, 3, Xs) ->
+  strict(arg_types(io, format, 3), Xs, fun (_) -> t_atom('ok') end);
+type(io, fwrite, 1, Xs) -> type(io, format, 1, Xs); % same
+type(io, fwrite, 2, Xs) -> type(io, format, 2, Xs); % same
+type(io, fwrite, 3, Xs) -> type(io, format, 3, Xs); % same
+type(io, put_chars, 1, Xs) ->
+  strict(arg_types(io, put_chars, 1), Xs, fun (_) -> t_atom('ok') end);
+type(io, put_chars, 2, Xs) ->
+  strict(arg_types(io, put_chars, 2), Xs, fun (_) -> t_atom('ok') end);
+%%-- io_lib -------------------------------------------------------------------
+type(io_lib, format, 2, Xs) ->
+  strict(arg_types(io_lib, format, 2), Xs,
+	 %% t_list() because the character list might be arbitrarily nested
+	 fun (_) -> t_list(t_sup(t_char(), t_list())) end);
+type(io_lib, fwrite, 2, Xs) -> type(io_lib, format, 2, Xs); % same
+%%-- lists --------------------------------------------------------------------
+type(lists, all, 2, Xs) ->
+  strict(arg_types(lists, all, 2), Xs, 
+	 fun ([F, L]) -> 
+	     case t_is_nil(L) of
+	       true -> t_atom('true');
+	       false ->
+		 El = t_list_elements(L),
+		 case check_fun_application(F, [El]) of
+		   ok -> 
+		     case t_is_cons(L) of
+		       true -> t_fun_range(F);
+		       false -> 
+			 %% The list can be empty.
+			 t_sup(t_atom('true'), t_fun_range(F))
+		     end;
+		   error ->
+		     case t_is_cons(L) of
+		       true -> t_none();
+		       false -> t_fun_range(F)
+		     end
+		 end
+	     end
+	 end);
+type(lists, any, 2, Xs) ->
+  strict(arg_types(lists, any, 2), Xs, 
+	 fun ([F, L]) -> 
+	     case t_is_nil(L) of
+	       true -> t_atom('false');
+	       false ->
+		 El = t_list_elements(L),
+		 case check_fun_application(F, [El]) of
+		   ok -> 
+		     case t_is_cons(L) of
+		       true -> t_fun_range(F);
+		       false -> 
+			 %% The list can be empty
+			 t_sup(t_atom('false'), t_fun_range(F))
+		     end;
+		   error ->
+		     case t_is_cons(L) of
+		       true -> t_none();
+		       false -> t_fun_range(F)
+		     end
+		 end
+	     end
+	 end);
+type(lists, append, 2, Xs) -> type(erlang, '++', 2, Xs);  % alias
+type(lists, delete, 2, Xs) ->
+  strict(arg_types(lists, delete, 2), Xs, 
+	 fun ([_, List]) -> 
+	     case t_is_cons(List) of
+	       true -> t_cons_tl(List);
+	       false -> List
+	     end
+	 end);
+type(lists, dropwhile, 2, Xs) -> 
+  strict(arg_types(lists, dropwhile, 2), Xs,
+	 fun ([F, X]) -> 
+	     case t_is_nil(X) of
+	       true -> t_nil();
+	       false ->
+		 X1 = t_list_elements(X),
+		 case check_fun_application(F, [X1]) of
+		   ok ->
+		     case t_atom_vals(t_fun_range(F)) of
+		       ['true'] ->
+			 case t_is_none(t_inf(t_list(), X)) of
+			   true -> t_none();
+			   false -> t_nil()
+			 end;
+		       ['false'] -> 
+			 case t_is_none(t_inf(t_list(), X)) of
+			   true -> t_none();
+			   false -> X
+			 end;
+		       _ -> 
+			 t_inf(t_cons_tl(t_inf(X, t_cons())), 
+			       t_maybe_improper_list())
+		     end;
+		   error ->
+		     case t_is_cons(X) of
+		       true -> t_none();
+		       false -> t_nil()
+		     end
+		 end
+	     end
+	 end);
+type(lists, filter, 2, Xs) ->
+  strict(arg_types(lists, filter, 2), Xs,
+	 fun ([F, L]) -> 
+	     case t_is_nil(L) of
+	       true -> t_nil();
+	       false ->
+		 T = t_list_elements(L),
+		 case check_fun_application(F, [T]) of
+		   ok ->
+		     case t_atom_vals(t_fun_range(F)) =:= ['false'] of
+		       true -> t_nil();
+		       false -> 
+			 case t_atom_vals(t_fun_range(F)) =:= ['true'] of
+			   true -> L;
+			   false -> t_list(T)
+			 end
+		     end;
+		   error ->
+		     case t_is_cons(L) of
+		       true -> t_none();
+		       false -> t_nil()
+		     end
+		 end
+	     end
+	 end);
+type(lists, flatten, 1, Xs) ->
+  strict(arg_types(lists, flatten, 1), Xs,
+	 fun ([L]) ->
+	     case t_is_nil(L) of
+	       true -> L;    % (nil has undefined elements)
+	       false ->
+		 %% Avoiding infinite recursion is tricky
+		 X1 = t_list_elements(L),
+		 case t_is_any(X1) of
+		   true -> 
+		     t_list();
+		   false ->
+		     X2 = type(lists, flatten, 1, [t_inf(X1, t_list())]),
+		     t_sup(t_list(t_subtract(X1, t_list())),
+			   X2)
+		 end
+	     end
+	 end);
+type(lists, flatmap, 2, Xs) ->
+  strict(arg_types(lists, flatmap, 2), Xs,
+	 fun ([F, List]) -> 
+	     case t_is_nil(List) of
+	       true -> t_nil();
+	       false ->
+		 case check_fun_application(F, [t_list_elements(List)]) of
+		   ok -> 
+		     case t_is_cons(List) of
+		       true -> t_nonempty_list(t_list_elements(t_fun_range(F)));
+		       false -> t_list(t_list_elements(t_fun_range(F)))
+		     end;
+		   error ->
+		     case t_is_cons(List) of
+		       true -> t_none();
+		       false -> t_nil()
+		     end
+		 end
+ 	     end
+	 end);
+type(lists, foreach, 2, Xs) ->
+  strict(arg_types(lists, foreach, 2), Xs,
+	 fun ([F, List]) ->
+	     case t_is_cons(List) of
+	       true ->
+		 case check_fun_application(F, [t_list_elements(List)]) of
+		   ok -> t_atom('ok');
+		   error -> t_none()
+		 end;
+	       false ->
+		 t_atom('ok')
+	     end
+	 end);
+type(lists, foldl, 3, Xs) ->
+  strict(arg_types(lists, foldl, 3), Xs,
+	 fun ([F, Acc, List]) ->
+	     case t_is_nil(List) of
+	       true -> Acc;
+	       false ->
+		 case check_fun_application(F, [t_list_elements(List), Acc]) of
+		   ok ->
+		     case t_is_cons(List) of
+		       true -> t_fun_range(F);
+		       false -> t_sup(t_fun_range(F), Acc)
+		     end;
+		   error ->
+		     case t_is_cons(List) of
+		       true -> t_none();
+		       false -> Acc
+		     end
+		 end
+	     end
+	 end);
+type(lists, foldr, 3, Xs) -> type(lists, foldl, 3, Xs);    % same
+type(lists, keydelete, 3, Xs) ->
+  strict(arg_types(lists, keydelete, 3), Xs, 
+	 fun ([_, _, L]) ->
+	     Term = t_list_termination(L),
+	     t_sup(Term, erl_types:lift_list_to_pos_empty(L))
+	 end);
+type(lists, keyfind, 3, Xs) ->
+  strict(arg_types(lists, keyfind, 3), Xs,
+	 fun ([X, Y, Z]) ->
+	     ListEs = t_list_elements(Z),
+	     Tuple = t_inf(t_tuple(), ListEs),
+	     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) of
+		       unknown -> Ret;
+		       List ->
+			 Keys = [type(erlang, element, 2, [Y, S])
+				 || S <- List],
+			 Infs = [t_inf(Key, X) || Key <- Keys],
+			 case all_is_none(Infs) of
+			   true -> t_atom('false');
+			   false -> Ret
+			 end
+		     end
+		 end
+	     end
+	 end);
+type(lists, keymap, 3, Xs) ->
+  strict(arg_types(lists, keymap, 3), Xs,
+	 fun ([F, _I, L]) ->
+	     case t_is_nil(L) of
+	       true -> L;
+	       false -> t_list(t_sup(t_fun_range(F), t_list_elements(L)))
+	     end
+	 end);
+type(lists, keymember, 3, Xs) ->
+  strict(arg_types(lists, keymember, 3), Xs,
+	 fun ([X, Y, Z]) ->
+	     ListEs = t_list_elements(Z),
+	     Tuple = t_inf(t_tuple(), ListEs),
+	     case t_is_none(Tuple) of
+	       true -> t_atom('false');
+	       false ->
+		 case t_is_any(X) of
+		   true -> t_boolean();
+		   false ->
+		     case t_tuple_subtypes(Tuple) of
+		       unknown -> t_boolean();
+		       List ->
+			 Keys = [type(erlang, element, 2, [Y,S]) || S <- List],
+			 Infs = [t_inf(Key, X) || Key <- Keys],
+			 case all_is_none(Infs) of
+			   true -> t_atom('false');
+			   false -> t_boolean()
+			 end
+		     end
+		 end
+	     end
+	 end);
+type(lists, keymerge, 3, Xs) ->
+  strict(arg_types(lists, keymerge, 3), Xs,
+	 fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end);
+type(lists, keyreplace, 4, Xs) ->
+  strict(arg_types(lists, keyreplace, 4), Xs,
+	 fun ([_K, _I, L, T]) -> t_list(t_sup(t_list_elements(L), T)) end);
+type(lists, keysearch, 3, Xs) ->
+  strict(arg_types(lists, keysearch, 3), Xs,
+	 fun ([X, Y, Z]) ->
+	     ListEs = t_list_elements(Z),
+	     Tuple = t_inf(t_tuple(), ListEs),
+	     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) of
+		       unknown -> Ret;
+		       List ->
+			 Keys = [type(erlang, element, 2, [Y, S])
+				 || S <- List],
+			 Infs = [t_inf(Key, X) || Key <- Keys],
+			 case all_is_none(Infs) of
+			   true -> t_atom('false');
+			   false -> Ret
+			 end
+		     end
+		 end
+	     end
+	 end);
+type(lists, keysort, 2, Xs) ->
+  strict(arg_types(lists, keysort, 2), Xs, fun ([_, L]) -> L end);
+type(lists, last, 1, Xs) ->
+  strict(arg_types(lists, last, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, map, 2, Xs) ->
+  strict(arg_types(lists, map, 2), Xs,
+	 fun ([F, L]) -> 
+	     case t_is_nil(L) of
+	       true -> L;
+	       false ->
+		 El = t_list_elements(L),
+		 case t_is_cons(L) of
+		   true ->
+		     case check_fun_application(F, [El]) of
+		       ok -> t_nonempty_list(t_fun_range(F));
+		       error -> t_none()
+		     end;
+		   false ->
+		     case check_fun_application(F, [El]) of
+		       ok -> t_list(t_fun_range(F));
+		       error -> t_nil()
+		     end
+		 end
+	     end
+	 end);
+type(lists, mapfoldl, 3, Xs) ->
+  strict(arg_types(lists, mapfoldl, 3), Xs,
+	 fun ([F, Acc, List]) ->
+	     case t_is_nil(List) of
+	       true -> t_tuple([List, Acc]);
+	       false ->
+		 El = t_list_elements(List),
+		 R = t_fun_range(F),
+		 case t_is_cons(List) of
+		   true ->
+		     case check_fun_application(F, [El, Acc]) of
+		       ok ->
+			 Fun = fun (RangeTuple) ->
+				   [T1, T2] = t_tuple_args(RangeTuple),
+				   t_tuple([t_nonempty_list(T1), T2])
+			       end,
+			 t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]);
+		       error -> 
+			 t_none()
+		     end;
+		   false ->
+		     case check_fun_application(F, [El, Acc]) of
+		       ok ->
+			 Fun = fun (RangeTuple) ->
+				   [T1, T2] = t_tuple_args(RangeTuple),
+				   t_tuple([t_list(T1), t_sup(Acc, T2)])
+			       end,
+			 t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]);
+		       error ->
+			 t_tuple([t_nil(), Acc])
+		     end
+		 end
+	     end
+	 end);
+type(lists, mapfoldr, 3, Xs) -> type(lists, mapfoldl, 3, Xs);    % same
+type(lists, max, 1, Xs) ->
+  strict(arg_types(lists, max, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, member, 2, Xs) ->
+  strict(arg_types(lists, member, 2), Xs,
+	 fun ([X, Y]) ->
+	     Y1 = t_list_elements(Y),
+	     case t_is_none(t_inf(Y1, X)) of
+	       true -> t_atom('false');
+	       false -> t_boolean()
+	     end
+	 end);
+%% type(lists, merge, 1, Xs) ->
+type(lists, merge, 2, Xs) ->
+  strict(arg_types(lists, merge, 2), Xs,
+	 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);
+%% type(lists, merge, 3, Xs) ->
+%% type(lists, merge3, 3, Xs) ->
+type(lists, min, 1, Xs) ->
+  strict(arg_types(lists, min, 1), Xs, fun ([L]) -> t_list_elements(L) end);
+type(lists, nth, 2, Xs) ->
+  strict(arg_types(lists, nth, 2), Xs,
+	 fun ([_, Y]) -> t_list_elements(Y) end);
+type(lists, nthtail, 2, Xs) ->
+  strict(arg_types(lists, nthtail, 2), Xs,
+	 fun ([_, Y]) -> t_sup(Y, t_list()) end);
+type(lists, partition, 2, Xs) ->
+  strict(arg_types(lists, partition, 2), Xs,
+	 fun ([F, L]) ->
+	     case t_is_nil(L) of
+	       true -> t_tuple([L,L]);
+	       false ->
+		 El = t_list_elements(L),
+		 case check_fun_application(F, [El]) of
+		   error -> 
+		     case t_is_cons(L) of
+		       true -> t_none();
+		       false -> t_tuple([t_nil(), t_nil()])
+		     end;
+		   ok ->
+		     case t_atom_vals(t_fun_range(F)) 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);
+type(lists, reverse, 1, Xs) ->
+  strict(arg_types(lists, reverse, 1), Xs, fun ([X]) -> X end);
+type(lists, reverse, 2, Xs) ->
+  type(erlang, '++', 2, Xs);    % reverse-onto is just like append
+type(lists, seq, 2, Xs) ->
+  strict(arg_types(lists, seq, 2), Xs, fun (_) -> t_list(t_integer()) end);
+type(lists, seq, 3, Xs) ->
+  strict(arg_types(lists, seq, 3), Xs, fun (_) -> t_list(t_integer()) end);
+type(lists, sort, 1, Xs) ->
+  strict(arg_types(lists, sort, 1), Xs, fun ([X]) -> X end);
+type(lists, sort, 2, Xs) ->
+  strict(arg_types(lists, sort, 2), Xs,
+	 fun ([F, L]) ->
+	     R = t_fun_range(F),
+	     case t_is_boolean(R) of
+	       true -> L;
+	       false ->
+		 case t_is_nil(L) of
+		   true -> t_nil();
+		   false -> t_none()
+		 end
+	     end
+	 end);
+type(lists, split, 2, Xs) ->
+  strict(arg_types(lists, split, 2), Xs,
+	 fun ([_, L]) ->
+	     case t_is_nil(L) of
+	       true -> t_tuple([L, L]);
+	       false ->
+		 T = t_list_elements(L),
+		 t_tuple([t_list(T), t_list(T)])
+	     end
+	 end);
+type(lists, splitwith, 2, Xs) -> 
+  T1 = type(lists, takewhile, 2, Xs),
+  T2 = type(lists, dropwhile, 2, Xs),
+  case t_is_none(T1) orelse t_is_none(T2) of
+    true -> t_none();
+    false -> t_tuple([T1, T2])
+  end;
+type(lists, subtract, 2, Xs) -> type(erlang, '--', 2, Xs);  % alias
+type(lists, takewhile, 2, Xs) ->
+  strict(arg_types(lists, takewhile, 2), Xs,
+	 fun([F, L]) ->
+	     case t_is_none(t_inf(t_list(), L)) of
+	       false -> type(lists, filter, 2, Xs);
+	       true ->
+		 %% This works for non-proper lists as well.
+		 El = t_list_elements(L),
+		 type(lists, filter, 2, [F, t_list(El)])
+	     end
+	 end);
+type(lists, usort, 1, Xs) -> type(lists, sort, 1, Xs); % same
+type(lists, usort, 2, Xs) -> type(lists, sort, 2, Xs); % same
+type(lists, unzip, 1, Xs) ->
+  strict(arg_types(lists, unzip, 1), Xs, 
+ 	 fun ([Ps]) ->
+	     case t_is_nil(Ps) of
+	       true ->
+		 t_tuple([t_nil(), t_nil()]);
+	       false -> % Ps is a proper list of pairs
+		 TupleTypes = t_tuple_subtypes(t_list_elements(Ps)),
+		 lists:foldl(fun(Tuple, Acc) ->
+				 [A, B] = t_tuple_args(Tuple),
+				 t_sup(t_tuple([t_list(A), t_list(B)]), Acc)
+			     end, t_none(), TupleTypes)
+	     end
+ 	 end);
+type(lists, unzip3, 1, Xs) ->
+  strict(arg_types(lists, unzip3, 1), Xs, 
+ 	 fun ([Ts]) ->
+	     case t_is_nil(Ts) of
+	       true ->
+		 t_tuple([t_nil(), t_nil(), t_nil()]);
+	       false -> % Ps is a proper list of triples
+		 TupleTypes = t_tuple_subtypes(t_list_elements(Ts)),
+		 lists:foldl(fun(T, Acc) ->
+				 [A, B, C] = t_tuple_args(T),
+				 t_sup(t_tuple([t_list(A), 
+						t_list(B), 
+						t_list(C)]),
+				       Acc)
+			     end, t_none(), TupleTypes)
+	     end
+ 	 end);
+type(lists, zip, 2, Xs) ->
+  strict(arg_types(lists, zip, 2), Xs,
+	 fun ([As, Bs]) ->
+	     case (t_is_nil(As) orelse t_is_nil(Bs)) of
+	       true -> t_nil();
+	       false ->
+		 A = t_list_elements(As),
+		 B = t_list_elements(Bs),
+		 t_list(t_tuple([A, B]))
+	     end
+	 end);
+type(lists, zip3, 3, Xs) ->
+  strict(arg_types(lists, zip3, 3), Xs,
+	 fun ([As, Bs, Cs]) ->
+	     case (t_is_nil(As) orelse t_is_nil(Bs) orelse t_is_nil(Cs)) of
+	       true -> t_nil();
+	       false ->
+		 A = t_list_elements(As),
+		 B = t_list_elements(Bs),
+		 C = t_list_elements(Cs),
+		 t_list(t_tuple([A, B, C]))
+	     end
+	 end);
+type(lists, zipwith, 3, Xs) ->
+  strict(arg_types(lists, zipwith, 3), Xs,
+	 fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end);
+type(lists, zipwith3, 4, Xs) ->
+  strict(arg_types(lists, zipwith3, 4), Xs,
+	 fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end);
+%%-- math ---------------------------------------------------------------------
+type(math, acos, 1, Xs) ->
+  strict(arg_types(math, acos, 1), Xs, fun (_) -> t_float() end);
+type(math, acosh, 1, Xs) ->
+  strict(arg_types(math, acosh, 1), Xs, fun (_) -> t_float() end);
+type(math, asin, 1, Xs) ->
+  strict(arg_types(math, asin, 1), Xs, fun (_) -> t_float() end);
+type(math, asinh, 1, Xs) ->
+  strict(arg_types(math, asinh, 1), Xs, fun (_) -> t_float() end);
+type(math, atan, 1, Xs) ->
+  strict(arg_types(math, atan, 1), Xs, fun (_) -> t_float() end);
+type(math, atan2, 2, Xs) ->
+  strict(arg_types(math, atan2, 2), Xs, fun (_) -> t_float() end);
+type(math, atanh, 1, Xs) ->
+  strict(arg_types(math, atanh, 1), Xs, fun (_) -> t_float() end);
+type(math, cos, 1, Xs) ->
+  strict(arg_types(math, cos, 1), Xs, fun (_) -> t_float() end);
+type(math, cosh, 1, Xs) ->
+  strict(arg_types(math, cosh, 1), Xs, fun (_) -> t_float() end);
+type(math, erf, 1, Xs) ->
+  strict(arg_types(math, erf, 1), Xs, fun (_) -> t_float() end);
+type(math, erfc, 1, Xs) ->
+  strict(arg_types(math, erfc, 1), Xs, fun (_) -> t_float() end);
+type(math, exp, 1, Xs) ->
+  strict(arg_types(math, exp, 1), Xs, fun (_) -> t_float() end);
+type(math, log, 1, Xs) ->
+  strict(arg_types(math, log, 1), Xs, fun (_) -> t_float() end);
+type(math, log10, 1, Xs) ->
+  strict(arg_types(math, log10, 1), Xs, fun (_) -> t_float() end);
+type(math, pi, 0, _) -> t_float();
+type(math, pow, 2, Xs) ->
+  strict(arg_types(math, pow, 2), Xs, fun (_) -> t_float() end);
+type(math, sin, 1, Xs) ->
+  strict(arg_types(math, sin, 1), Xs, fun (_) -> t_float() end);
+type(math, sinh, 1, Xs) ->
+  strict(arg_types(math, sinh, 1), Xs, fun (_) -> t_float() end);
+type(math, sqrt, 1, Xs) ->
+  strict(arg_types(math, sqrt, 1), Xs, fun (_) -> t_float() end);
+type(math, tan, 1, Xs) ->
+  strict(arg_types(math, tan, 1), Xs, fun (_) -> t_float() end);
+type(math, tanh, 1, Xs) ->
+  strict(arg_types(math, tanh, 1), Xs, fun (_) -> t_float() end);
+%%-- net_kernel ---------------------------------------------------------------
+type(net_kernel, dflag_unicode_io, 1, Xs) ->
+  strict(arg_types(net_kernel, dflag_unicode_io, 1), Xs, 
+	 fun (_) -> t_boolean() end); 
+%%-- ordsets ------------------------------------------------------------------
+type(ordsets, filter, 2, Xs) ->
+  type(lists, filter, 2, Xs);
+type(ordsets, fold, 3, Xs) ->
+  type(lists, foldl, 3, Xs);
+%%-- os -----------------------------------------------------------------------
+type(os, getenv, 0, _) -> t_list(t_string());
+type(os, getenv, 1, Xs) ->
+  strict(arg_types(os, getenv, 1), Xs,
+	 fun (_) -> t_sup(t_string(), t_atom('false')) end);
+type(os, getpid, 0, _) -> t_string();
+type(os, putenv, 2, Xs) ->
+  strict(arg_types(os, putenv, 2), Xs, fun (_) -> t_atom('true') end);
+%%-- re -----------------------------------------------------------------------
+type(re, compile, 1, Xs) ->
+  strict(arg_types(re, compile, 1), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_re_MP()]),
+		   t_tuple([t_atom('error'), t_re_ErrorSpec()]))
+	 end);
+type(re, compile, 2, Xs) ->
+  strict(arg_types(re, compile, 2), Xs,
+	 fun (_) ->
+	     t_sup(t_tuple([t_atom('ok'), t_re_MP()]),
+		   t_tuple([t_atom('error'), t_re_ErrorSpec()]))
+	 end);
+type(re, run, 2, Xs) ->
+  strict(arg_types(re, run, 2), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('match'), t_re_Captured()]),
+		    t_atom('nomatch'),
+		    t_tuple([t_atom('error'), t_re_ErrorSpec()])])
+	 end);
+type(re, run, 3, Xs) ->
+  strict(arg_types(re, run, 3), Xs,
+	 fun (_) ->
+	     t_sup([t_tuple([t_atom('match'), t_re_Captured()]),
+		    t_atom('match'),
+		    t_atom('nomatch'),
+		    t_tuple([t_atom('error'), t_re_ErrorSpec()])])
+	 end);
+%%-- string -------------------------------------------------------------------
+type(string, chars, 2, Xs) ->  % NOTE: added to avoid loss of information
+  strict(arg_types(string, chars, 2), Xs, fun (_) -> t_string() end);
+type(string, chars, 3, Xs) ->  % NOTE: added to avoid loss of information
+  strict(arg_types(string, chars, 3), Xs,
+	 fun ([Char, N, Tail]) ->
+	     case t_is_nil(Tail) of
+	       true ->
+		 type(string, chars, 2, [Char, N]);
+	       false ->
+		 case t_is_string(Tail) of
+		   true ->
+		     t_string();
+		   false ->
+		     t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail))
+		 end
+	     end
+	 end);
+type(string, concat, 2, Xs) -> % NOTE: added to avoid loss of information
+  strict(arg_types(string, concat, 2), Xs, fun (_) -> t_string() end);
+type(string, equal, 2, Xs) ->  % NOTE: added to avoid loss of information
+  strict(arg_types(string, equal, 2), Xs, fun (_) -> t_boolean() end);
+type(string, to_float, 1, Xs) ->
+  strict(arg_types(string, to_float, 1), Xs,
+	 fun (_) -> t_sup(t_tuple([t_float(), t_string()]),
+			  t_tuple([t_atom('error'),
+				   t_sup(t_atom('no_float'),
+					 t_atom('not_a_list'))]))
+	 end);
+type(string, to_integer, 1, Xs) ->
+  strict(arg_types(string, to_integer, 1), Xs,
+	 fun (_) -> t_sup(t_tuple([t_integer(), t_string()]),
+			  t_tuple([t_atom('error'),
+				   t_sup(t_atom('no_integer'),
+					 t_atom('not_a_list'))]))
+	 end);
+%%-- unicode ------------------------------------------------------------------
+type(unicode, characters_to_binary, 2, Xs) ->
+  strict(arg_types(unicode, characters_to_binary, 2), Xs,
+	 fun (_) -> 
+	     t_sup([t_binary(),
+		    t_tuple([t_atom('error'), t_binary(), t_ML()]),
+		    t_tuple([t_atom('incomplete'), t_binary(), t_ML()])])
+		    end);
+type(unicode, characters_to_list, 2, Xs) ->
+  strict(arg_types(unicode, characters_to_list, 2), Xs,
+	 fun (_) ->
+	     t_sup([t_string(),
+		    t_tuple([t_atom('error'), t_string(), t_ML()]),
+		    t_tuple([t_atom('incomplete'), t_string(), t_ML()])])
+	 end);
+type(unicode, bin_is_7bit, 1, Xs) ->
+  strict(arg_types(unicode, bin_is_7bit, 1), Xs, fun (_) -> t_boolean() end);
+
+%%-----------------------------------------------------------------------------
+type(M, F, A, Xs) when is_atom(M), is_atom(F),
+		       is_integer(A), 0 =< A, A =< 255 ->
+  strict(Xs, t_any()).  % safe approximation for all functions.
+
+
+%%-----------------------------------------------------------------------------
+%% Auxiliary functions
+%%-----------------------------------------------------------------------------
+
+strict(Xs, Ts, F) ->
+  %% io:format("inf lists arg~n1:~p~n2:~p ~n", [Xs, Ts]),
+  Xs1 = inf_lists(Xs, Ts),
+  %% io:format("inf lists return ~p ~n", [Xs1]),
+  case any_is_none_or_unit(Xs1) of
+    true -> t_none();
+    false -> F(Xs1)
+  end.
+
+strict(Xs, X) ->
+  case any_is_none_or_unit(Xs) of
+    true -> t_none();
+    false -> X
+  end.
+
+inf_lists([X | Xs], [T | Ts]) ->
+  [t_inf(X, T) | inf_lists(Xs, Ts)];
+inf_lists([], []) ->
+  [].
+
+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).
+
+all_is_none(Ts) ->
+  lists:all(fun erl_types:t_is_none/1, Ts).
+
+check_guard([X], Test, Type) ->
+  check_guard_single(X, Test, Type).
+
+check_guard_single(X, Test, Type) ->
+  case Test(X) of
+    true -> t_atom('true');
+    false ->
+      case erl_types:t_is_opaque(X) of
+	true -> t_none();
+	false ->
+	  case t_is_none(t_inf(Type, X)) of
+	    true -> t_atom('false');
+	    false -> t_boolean()
+	  end
+      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(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) ->
+  Number1 + Number2.
+
+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)->
+  Number1 * Number2.
+
+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) ->
+  case t_is_integer(X1) of
+    false -> error;
+    true ->
+      Min1 = number_min(X1),
+      Max1 = number_max(X1),
+      {ok, t_from_range(infinity_add(infinity_inv(Max1), -1),
+			infinity_add(infinity_inv(Min1), -1))}
+  end.
+
+arith_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)]),
+  Max_range2_leq_zero = infinity_geq(0, Max_range2),
+  New_min = 
+    if Min1_geq_zero -> 0;
+       Max_range2 =:= 0 -> 0;
+       Max_range2_leq_zero -> infinity_add(Max_range2, 1);
+       true -> infinity_add(infinity_inv(Max_range2), 1)
+    end,
+  New_max = 
+    if Max1_leq_zero -> 0;
+       Max_range2 =:= 0 -> 0;
+       Max_range2_leq_zero -> infinity_add(infinity_inv(Max_range2), -1);
+       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) ->
+  L1 = t_number_vals(X1), 
+  L2 = t_number_vals(X2),
+  Min1 = number_min(X1),
+  Max1 = number_max(X1),
+  Min2 = number_min(X2),
+  Max2 = number_max(X2),
+  case {L1 =:= unknown, L2 =:= unknown} of
+    {true, false} ->
+      arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2);
+    {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) ->
+  L1 = t_number_vals(X1), 
+  L2 = t_number_vals(X2),
+  Min1 = number_min(X1),
+  Max1 = number_max(X1),
+  Min2 = number_min(X2),
+  Max2 = number_max(X2),
+  case {L1 =:= unknown, L2 =:= unknown} of
+    {true, false} ->
+      arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2);
+    {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) ->
+  %% io:format("arith ~p ~p ~p~n", [Op, X1, X2]),
+  case t_is_integer(X1) andalso t_is_integer(X2) of
+    false -> error;
+    true ->
+      L1 = t_number_vals(X1), 
+      L2 = t_number_vals(X2),
+      case (L1 =:= unknown) orelse (L2 =:= unknown) of
+	true ->
+	  Min1 = number_min(X1),
+	  Max1 = number_max(X1),
+	  Min2 = number_min(X2),
+	  Max2 = number_max(X2),
+	  {NewMin, NewMax} =
+	    case Op of
+	      '+'    -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)};
+	      '-'    -> {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);
+	      'bor'  -> arith_bor(X1, X2);
+	      'bxor' -> arith_bor_ranges(Min1, Max1, Min2, Max2) %% overaprox.
+	    end,
+	  %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]),
+	  {ok, t_from_range(NewMin, NewMax)};
+	false ->  
+	  AllVals =
+	    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,
+	  {ok, t_integers(ordsets:from_list(AllVals))}
+      end
+  end.
+
+%%=============================================================================
+
+-spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'.
+
+%%------- code ----------------------------------------------------------------
+arg_types(code, add_path, 1) ->
+  [t_string()];
+arg_types(code, add_patha, 1) ->
+  arg_types(code, add_path, 1);
+arg_types(code, add_paths, 1) ->
+  [t_list(t_string())];
+arg_types(code, add_pathsa, 1) ->
+  arg_types(code, add_paths, 1);
+arg_types(code, add_pathsz, 1) ->
+  arg_types(code, add_paths, 1);
+arg_types(code, add_pathz, 1) ->
+  arg_types(code, add_path, 1);
+arg_types(code, all_loaded, 0) ->
+  [];
+arg_types(code, compiler_dir, 0) ->
+  [];
+arg_types(code, del_path, 1) ->
+  [t_sup(t_string(), t_atom())];  % OBS: doc differs from add_path/1 - why?
+arg_types(code, delete, 1) ->
+  [t_atom()];
+arg_types(code, ensure_loaded, 1) ->
+  arg_types(code, load_file, 1);
+arg_types(code, get_chunk, 2) ->
+  [t_binary(), t_string()];
+arg_types(code, get_object_code, 1) ->
+  [t_atom()];
+arg_types(code, get_path, 0) ->
+  [];
+arg_types(code, is_loaded, 1) ->
+  [t_atom()];
+arg_types(code, is_sticky, 1) ->
+  [t_atom()];
+arg_types(code, is_module_native, 1) ->
+  [t_atom()];
+arg_types(code, lib_dir, 0) ->
+  [];
+arg_types(code, lib_dir, 1) ->
+  [t_atom()];
+arg_types(code, load_abs, 1) ->
+  [t_string()];
+arg_types(code, load_abs, 2) ->
+  [t_code_loaded_fname_or_status(), t_atom()];
+arg_types(code, load_binary, 3) ->
+  [t_atom(), t_code_loaded_fname_or_status(), t_binary()];
+arg_types(code, load_file, 1) ->
+  [t_atom()];
+arg_types(code, load_native_partial, 2) ->
+  [t_atom(), t_binary()];
+arg_types(code, load_native_sticky, 3) ->
+  [t_atom(), t_binary(), t_sup(t_binary(), t_atom('false'))];
+arg_types(code, module_md5, 1) ->
+  [t_binary()];
+arg_types(code, make_stub_module, 3) ->
+  [t_atom(), t_binary(), t_tuple([t_list(), t_list()])];
+arg_types(code, priv_dir, 1) ->
+  [t_atom()];
+arg_types(code, purge, 1) ->
+  arg_types(code, delete, 1);
+arg_types(code, rehash, 0) ->
+  [];
+arg_types(code, replace_path, 2) ->
+  [t_atom(), t_string()];
+arg_types(code, root_dir, 0) ->
+  [];
+arg_types(code, set_path, 1) ->
+  [t_string()];
+arg_types(code, soft_purge, 1) ->
+  arg_types(code, delete, 1);
+arg_types(code, stick_mod, 1) ->
+  [t_atom()];
+arg_types(code, unstick_mod, 1) ->
+  arg_types(code, stick_mod, 1);
+arg_types(code, which, 1) ->
+  [t_atom()];
+%%------- erl_ddll ------------------------------------------------------------
+arg_types(erl_ddll, demonitor, 1) ->
+  arg_types(erlang, demonitor, 1);
+arg_types(erl_ddll, format_error_int, 1) ->
+  [t_sup([t_atom('inconsistent'),
+	  t_atom('linked_in_driver'),
+	  t_atom('permanent'),
+	  t_atom('not_loaded'),
+	  t_atom('not_loaded_by_this_process'),
+	  t_atom('not_pending'),
+	  t_atom('already_loaded'),
+	  t_atom('unloading')])];
+arg_types(erl_ddll, info, 2) ->
+  [t_sup([t_atom(), t_string()]),
+   t_sup([t_atom('awaiting_load'),
+	  t_atom('awaiting_unload'),
+	  t_atom('driver_options'),
+	  t_atom('linked_in_driver'),
+	  t_atom('permanent'),
+	  t_atom('port_count'),
+	  t_atom('processes')])];
+arg_types(erl_ddll, loaded_drivers, 0) ->
+  [];
+arg_types(erl_ddll, monitor, 2) ->
+  [t_atom('driver'),
+   t_tuple([t_atom(), t_sup([t_atom('loaded'), t_atom('unloaded')])])];
+arg_types(erl_ddll, try_load, 3) ->
+  [t_sup([t_atom(), t_string(), t_nonempty_list(t_sup([t_atom(), t_string()]))]),
+   t_sup([t_atom(), t_string()]),
+   t_list(t_sup([t_tuple([t_atom('driver_options'),
+			  t_list(t_atom('kill_ports'))]),
+		 t_tuple([t_atom('monitor'),
+			  t_sup([t_atom('pending_driver'),
+				 t_atom('pending')])]),
+		 t_tuple([t_atom('reload'),
+			  t_sup([t_atom('pending_driver'),
+				 t_atom('pending')])])]))];
+arg_types(erl_ddll, try_unload, 2) ->
+  [t_sup([t_atom(), t_string(), t_nonempty_list(t_sup([t_atom(), t_string()]))]),
+   t_list(t_sup([t_atom('kill_ports'),
+		 t_tuple([t_atom('monitor'),
+			  t_sup([t_atom('pending_driver'),
+				 t_atom('pending')])])]))];
+%%------- 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()];
+arg_types(erlang, abs, 1) ->
+  [t_number()];
+arg_types(erlang, append_element, 2) ->
+  [t_tuple(), t_any()];
+arg_types(erlang, apply, 2) ->
+  [t_sup(t_tuple([t_sup(t_atom(),   % module name
+			t_tuple()), % parameterized module	    
+		  t_atom()]),
+	 t_fun()),
+   t_list()];
+arg_types(erlang, apply, 3) ->
+  [t_sup(t_atom(), t_tuple()), t_atom(), t_list()];
+arg_types(erlang, atom_to_binary, 2) ->
+  [t_atom(), t_encoding_a2b()];
+arg_types(erlang, atom_to_list, 1) ->
+  [t_atom()];
+arg_types(erlang, binary_to_atom, 2) ->
+  [t_binary(), t_encoding_a2b()];
+arg_types(erlang, binary_to_existing_atom, 2) ->
+  arg_types(erlang, binary_to_atom, 2);
+arg_types(erlang, binary_to_list, 1) ->
+  [t_binary()];
+arg_types(erlang, binary_to_list, 3) ->
+  [t_binary(), t_pos_integer(), t_pos_integer()]; % I want fixnum, but cannot
+arg_types(erlang, binary_to_term, 1) ->
+  [t_binary()];
+arg_types(erlang, bitsize, 1) ->	% XXX: TAKE OUT
+  arg_types(erlang, bit_size, 1);
+arg_types(erlang, bit_size, 1) ->
+  [t_bitstr()];
+arg_types(erlang, bitstr_to_list, 1) ->	% XXX: TAKE OUT
+  arg_types(erlang, bitstring_to_list, 1);
+arg_types(erlang, bitstring_to_list, 1) ->
+  [t_bitstr()];
+arg_types(erlang, bump_reductions, 1) ->
+  [t_pos_fixnum()];
+arg_types(erlang, byte_size, 1) ->
+  [t_binary()];
+arg_types(erlang, cancel_timer, 1) ->
+  [t_reference()];
+arg_types(erlang, check_process_code, 2) ->
+  [t_pid(), t_atom()];
+arg_types(erlang, concat_binary, 1) ->
+  [t_list(t_binary())];
+arg_types(erlang, crc32, 1) ->
+  [t_iodata()];
+arg_types(erlang, crc32, 2) ->
+  [t_integer(), t_iodata()];
+arg_types(erlang, crc32_combine, 3) ->
+  [t_integer(), t_integer(), t_integer()];
+arg_types(erlang, date, 0) ->
+  [];
+arg_types(erlang, decode_packet, 3) ->
+  [t_decode_packet_type(), t_binary(), t_list(t_decode_packet_option())];
+arg_types(erlang, delete_module, 1) ->
+  [t_atom()];
+arg_types(erlang, demonitor, 1) ->
+  [t_reference()];
+arg_types(erlang, demonitor, 2) ->
+  [t_reference(), t_list(t_atoms(['flush', 'info']))];
+arg_types(erlang, disconnect_node, 1) ->
+  [t_node()];
+arg_types(erlang, display, 1) ->
+  [t_any()];
+arg_types(erlang, dist_exit, 3) ->
+  [t_pid(), t_dist_exit(), t_sup(t_pid(), t_port())];
+arg_types(erlang, element, 2) ->
+  [t_pos_fixnum(), t_tuple()];
+arg_types(erlang, erase, 0) ->
+  [];
+arg_types(erlang, erase, 1) ->
+  [t_any()];
+arg_types(erlang, error, 1) ->
+  [t_any()];
+arg_types(erlang, error, 2) ->
+  [t_any(), t_list()];
+arg_types(erlang, exit, 1) ->
+  [t_any()];
+arg_types(erlang, exit, 2) ->
+  [t_sup(t_pid(), t_port()), t_any()];
+arg_types(erlang, external_size, 1) ->
+  [t_any()]; % takes any term as input
+arg_types(erlang, float, 1) ->
+  [t_number()];
+arg_types(erlang, float_to_list, 1) ->
+  [t_float()];
+arg_types(erlang, function_exported, 3) ->
+  [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, fun_info, 1) ->
+  [t_fun()];
+arg_types(erlang, fun_info, 2) ->
+  [t_fun(), t_atom()];
+arg_types(erlang, fun_to_list, 1) ->
+  [t_fun()];
+arg_types(erlang, garbage_collect, 0) ->
+  [];
+arg_types(erlang, garbage_collect, 1) ->
+  [t_pid()];
+arg_types(erlang, get, 0) ->
+  [];
+arg_types(erlang, get, 1) ->
+  [t_any()];
+arg_types(erlang, get_cookie, 0) ->
+  [];
+arg_types(erlang, get_keys, 1) ->
+  [t_any()];
+arg_types(erlang, get_stacktrace, 0) ->
+  [];
+arg_types(erlang, get_module_info, 1) ->
+  [t_atom()];
+arg_types(erlang, get_module_info, 2) ->
+  [t_atom(), t_module_info_2()];
+arg_types(erlang, group_leader, 0) ->
+  [];
+arg_types(erlang, group_leader, 2) ->
+  [t_pid(), t_pid()];
+arg_types(erlang, halt, 0) ->
+  [];
+arg_types(erlang, halt, 1) ->
+  [t_sup(t_non_neg_fixnum(), t_string())];
+arg_types(erlang, hash, 2) ->
+  [t_any(), t_integer()];
+arg_types(erlang, hd, 1) ->
+  [t_cons()];
+arg_types(erlang, hibernate, 3) ->
+  [t_atom(), t_atom(), t_list()];
+arg_types(erlang, info, 1) ->
+  arg_types(erlang, system_info, 1); % alias
+arg_types(erlang, iolist_to_binary, 1) ->
+  [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, iolist_size, 1) ->
+  [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, integer_to_list, 1) ->
+  [t_integer()];
+arg_types(erlang, is_alive, 0) ->
+  [];
+arg_types(erlang, is_atom, 1) ->
+  [t_any()];
+arg_types(erlang, is_binary, 1) ->
+  [t_any()];
+arg_types(erlang, is_bitstr, 1) ->	% XXX: TAKE OUT
+  arg_types(erlang, is_bitstring, 1);
+arg_types(erlang, is_bitstring, 1) ->
+  [t_any()];
+arg_types(erlang, is_boolean, 1) ->
+  [t_any()];
+arg_types(erlang, is_builtin, 3) ->
+  [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, is_constant, 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_number, 1) ->
+  [t_any()];
+arg_types(erlang, is_pid, 1) ->
+  [t_any()];
+arg_types(erlang, is_port, 1) ->
+  [t_any()];
+arg_types(erlang, is_process_alive, 1) ->
+  [t_pid()];
+arg_types(erlang, is_record, 2) ->
+  [t_any(), t_atom()];
+arg_types(erlang, is_record, 3) ->
+  [t_any(), t_atom(), t_pos_fixnum()];
+arg_types(erlang, is_reference, 1) ->
+  [t_any()];
+arg_types(erlang, is_tuple, 1) ->
+  [t_any()];
+arg_types(erlang, length, 1) ->
+  [t_list()];
+arg_types(erlang, link, 1) ->
+  [t_sup(t_pid(), t_port())];
+arg_types(erlang, list_to_atom, 1) ->
+  [t_string()];
+arg_types(erlang, list_to_binary, 1) ->
+  [t_iolist()];
+arg_types(erlang, list_to_bitstr, 1) ->	% XXX: TAKE OUT
+  arg_types(erlang, list_to_bitstring, 1);
+arg_types(erlang, list_to_bitstring, 1) ->
+  [t_iolist()];
+arg_types(erlang, list_to_existing_atom, 1) ->
+  [t_string()];
+arg_types(erlang, list_to_float, 1) ->
+  [t_list(t_byte())];
+arg_types(erlang, list_to_integer, 1) ->
+  [t_list(t_byte())];
+arg_types(erlang, list_to_pid, 1) ->
+  [t_string()];
+arg_types(erlang, list_to_tuple, 1) ->
+  [t_list()];
+arg_types(erlang, loaded, 0) ->
+  [];
+arg_types(erlang, load_module, 2) ->
+  [t_atom(), t_binary()];
+arg_types(erlang, localtime, 0) ->
+  [];
+arg_types(erlang, localtime_to_universaltime, 1) ->
+  [t_tuple([t_date(), t_time()])];
+arg_types(erlang, localtime_to_universaltime, 2) ->
+  arg_types(erlang, localtime_to_universaltime, 1) ++
+    [t_sup(t_boolean(), t_atom('undefined'))];
+arg_types(erlang, make_fun, 3) ->
+  [t_atom(), t_atom(), t_arity()];
+arg_types(erlang, make_ref, 0) ->
+  [];
+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, match_spec_test, 3) ->
+  [t_sup(t_list(), t_tuple()),
+   t_any(),
+   t_sup(t_atom('table'), t_atom('trace'))];
+arg_types(erlang, md5, 1) ->
+  [t_sup(t_iolist(), t_binary())];
+arg_types(erlang, md5_final, 1) ->
+  [t_binary()];
+arg_types(erlang, md5_init, 0) ->
+  [];
+arg_types(erlang, md5_update, 2) ->
+  [t_binary(), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, memory, 0) ->
+  [];
+arg_types(erlang, memory, 1) ->
+  Arg = t_atoms(['total', 'processes', 'processes_used', 'system',
+		 'atom', 'atom_used', 'binary', 'code', 'ets',
+		 'maximum']),
+  [t_sup(Arg, t_list(Arg))];
+arg_types(erlang, module_loaded, 1) ->
+  [t_atom()];
+arg_types(erlang, monitor, 2) ->
+  [t_atom(), t_sup([t_pid(), t_atom(), t_tuple([t_atom(), t_node()])])];
+arg_types(erlang, monitor_node, 2) ->
+  [t_node(), t_boolean()];
+arg_types(erlang, monitor_node, 3) ->
+  [t_node(), t_boolean(), t_list(t_atom('allow_passive_connect'))];
+arg_types(erlang, node, 0) ->
+  [];
+arg_types(erlang, node, 1) ->
+  [t_identifier()];
+arg_types(erlang, nodes, 0) ->
+  [];
+arg_types(erlang, nodes, 1) ->
+  NodesArg = t_atoms(['visible', 'hidden', 'connected', 'this', 'known']),
+  [t_sup(NodesArg, t_list(NodesArg))];
+arg_types(erlang, now, 0) ->
+  [];
+arg_types(erlang, open_port, 2) ->
+  [t_sup(t_atom(), t_sup([t_tuple([t_atom('spawn'), t_string()]),
+			  t_tuple([t_atom('spawn_driver'), t_string()]),
+			  t_tuple([t_atom('spawn_executable'), t_string()]),
+			  t_tuple([t_atom('fd'), t_integer(), t_integer()])])),
+   t_list(t_sup(t_sup([t_atom('stream'),
+		       t_atom('exit_status'),
+		       t_atom('use_stdio'),
+		       t_atom('nouse_stdio'),
+		       t_atom('stderr_to_stdout'),
+		       t_atom('in'),
+		       t_atom('out'),
+		       t_atom('binary'),
+		       t_atom('eof'),
+		       t_atom('hide')]),
+		t_sup([t_tuple([t_atom('packet'), t_integer()]),
+		       t_tuple([t_atom('line'), t_integer()]),
+		       t_tuple([t_atom('cd'), t_string()]),
+		       t_tuple([t_atom('env'), t_list(t_tuple(2))]), % XXX: More
+		       t_tuple([t_atom('args'), t_list(t_string())]),
+		       t_tuple([t_atom('arg0'), t_string()])])))];
+arg_types(erlang, phash, 2) ->
+  [t_any(), t_pos_integer()];
+arg_types(erlang, phash2, 1) ->
+  [t_any()];
+arg_types(erlang, phash2, 2) ->
+  [t_any(), t_pos_integer()];
+arg_types(erlang, pid_to_list, 1) ->
+  [t_pid()];
+arg_types(erlang, port_call, 3) ->
+  [t_sup(t_port(), t_atom()), t_integer(), t_any()];
+arg_types(erlang, port_close, 1) ->
+  [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_command, 2) ->
+  [t_sup(t_port(), t_atom()), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, port_command, 3) ->
+  [t_sup(t_port(), t_atom()),
+   t_sup(t_iolist(), t_binary()),
+   t_list(t_atoms(['force', 'nosuspend']))];
+arg_types(erlang, port_connect, 2) ->
+  [t_sup(t_port(), t_atom()), t_pid()];
+arg_types(erlang, port_control, 3) ->
+  [t_sup(t_port(), t_atom()), t_integer(), t_sup(t_iolist(), t_binary())];
+arg_types(erlang, port_get_data, 1) ->
+  [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_info, 1) ->
+  [t_sup(t_port(), t_atom())];
+arg_types(erlang, port_info, 2) ->
+  [t_sup(t_port(), t_atom()),
+   t_atoms(['registered_name', 'id', 'connected',
+	    'links', 'name', 'input', 'output'])];
+arg_types(erlang, port_to_list, 1) ->
+  [t_port()];
+arg_types(erlang, ports, 0) ->
+  [];
+arg_types(erlang, port_set_data, 2) ->
+  [t_sup(t_port(), t_atom()), t_any()];
+arg_types(erlang, pre_loaded, 0) ->
+  [];
+arg_types(erlang, process_display, 2) ->
+  [t_pid(), t_atom('backtrace')];
+arg_types(erlang, process_flag, 2) ->
+  [t_sup([t_atom('trap_exit'), t_atom('error_handler'),
+	  t_atom('min_heap_size'), t_atom('priority'), t_atom('save_calls'),
+	  t_atom('monitor_nodes'), 			  % undocumented
+	  t_tuple([t_atom('monitor_nodes'), t_list()])]), % undocumented
+   t_sup([t_boolean(), t_atom(), t_non_neg_integer()])];
+arg_types(erlang, process_flag, 3) ->
+  [t_pid(), t_atom('save_calls'), t_non_neg_integer()];
+arg_types(erlang, process_info, 1) ->
+  [t_pid()];
+arg_types(erlang, process_info, 2) ->
+  [t_pid(), t_pinfo()];
+arg_types(erlang, processes, 0) ->
+  [];
+arg_types(erlang, purge_module, 1) ->
+  [t_atom()];
+arg_types(erlang, put, 2) ->
+  [t_any(), t_any()];
+arg_types(erlang, raise, 3) ->
+  [t_raise_errorclass(), t_any(), type(erlang, get_stacktrace, 0, [])];
+arg_types(erlang, read_timer, 1) ->
+  [t_reference()];
+arg_types(erlang, ref_to_list, 1) ->
+  [t_reference()];
+arg_types(erlang, register, 2) ->
+  [t_atom(), t_sup(t_port(), t_pid())];
+arg_types(erlang, registered, 0) ->
+  [];
+arg_types(erlang, resume_process, 1) ->
+  [t_pid()]; % intended for debugging only
+arg_types(erlang, round, 1) ->
+  [t_number()];
+arg_types(erlang, self, 0) ->
+  [];
+arg_types(erlang, send, 2) ->
+  arg_types(erlang, '!', 2);  % alias
+arg_types(erlang, send, 3) ->
+  arg_types(erlang, send, 2) ++ [t_list(t_sendoptions())];
+arg_types(erlang, send_after, 3) ->
+  [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()];
+arg_types(erlang, seq_trace, 2) ->
+  [t_atom(), t_sup([t_boolean(), t_tuple([t_fixnum(), t_fixnum()]), t_nil()])];
+arg_types(erlang, seq_trace_info, 1) ->
+  [t_seq_trace_info()];
+arg_types(erlang, seq_trace_print, 1) ->
+  [t_any()];
+arg_types(erlang, seq_trace_print, 2) ->
+  [t_sup(t_atom(), t_fixnum()), t_any()];
+arg_types(erlang, set_cookie, 2) ->
+  [t_node(), t_atom()];
+arg_types(erlang, setelement, 3) ->
+  [t_pos_integer(), t_tuple(), t_any()];
+arg_types(erlang, setnode, 2) ->
+  [t_atom(), t_integer()];
+arg_types(erlang, setnode, 3) ->
+  [t_atom(), t_port(), t_tuple(4)];
+arg_types(erlang, size, 1) ->
+  [t_sup(t_tuple(), t_binary())];
+arg_types(erlang, spawn, 1) -> %% TODO: Tuple?
+  [t_fun()];
+arg_types(erlang, spawn, 2) -> %% TODO: Tuple?
+  [t_node(), t_fun()];
+arg_types(erlang, spawn, 3) -> %% TODO: Tuple?
+  [t_atom(), t_atom(), t_list()];
+arg_types(erlang, spawn, 4) -> %% TODO: Tuple?
+  [t_node(), t_atom(), t_atom(), t_list()];
+arg_types(erlang, spawn_link, 1) ->
+  arg_types(erlang, spawn, 1);  % same
+arg_types(erlang, spawn_link, 2) ->
+  arg_types(erlang, spawn, 2);  % same
+arg_types(erlang, spawn_link, 3) ->
+  arg_types(erlang, spawn, 3);  % same
+arg_types(erlang, spawn_link, 4) ->
+  arg_types(erlang, spawn, 4);  % same
+arg_types(erlang, spawn_opt, 1) ->
+  [t_tuple([t_atom(), t_atom(), t_list(), t_list(t_spawn_options())])];
+arg_types(erlang, spawn_opt, 2) ->
+  [t_fun(), t_list(t_spawn_options())];
+arg_types(erlang, spawn_opt, 3) ->
+  [t_atom(), t_fun(), t_list(t_spawn_options())];
+arg_types(erlang, spawn_opt, 4) ->
+  [t_node(), t_atom(), t_list(), t_list(t_spawn_options())];
+arg_types(erlang, split_binary, 2) ->
+  [t_binary(), t_non_neg_integer()];
+arg_types(erlang, start_timer, 3) ->
+  [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()];
+arg_types(erlang, statistics, 1) ->
+  [t_sup([t_atom('context_switches'),
+	  t_atom('exact_reductions'),
+	  t_atom('garbage_collection'),
+	  t_atom('io'),
+	  t_atom('reductions'),
+	  t_atom('run_queue'),
+	  t_atom('runtime'),
+	  t_atom('wall_clock')])];
+arg_types(erlang, suspend_process, 1) ->
+  [t_pid()];
+arg_types(erlang, suspend_process, 2) ->
+  [t_pid(), t_list(t_sup([t_atom('unless_suspending'),
+			  t_atom('asynchronous')]))];
+arg_types(erlang, system_flag, 2) ->
+  [t_sup([t_atom('backtrace_depth'),
+	  t_atom('cpu_topology'),
+	  t_atom('debug_flags'),	% undocumented
+	  t_atom('display_items'),	% undocumented
+	  t_atom('fullsweep_after'),
+	  t_atom('min_heap_size'),
+	  t_atom('multi_scheduling'),
+	  t_atom('schedulers_online'),
+	  t_atom('scheduler_bind_type'),
+	  %% Undocumented; used to implement (the documented) seq_trace module.
+	  t_atom('sequential_tracer'),
+	  t_atom('trace_control_word'),
+	  %% 'internal_cpu_topology' is an undocumented internal feature.
+	  t_atom('internal_cpu_topology'),
+	  t_integer()]),
+   t_sup([t_integer(),
+	  %% 'cpu_topology'
+	  t_system_cpu_topology(),
+	  %% 'scheduler_bind_type'
+	  t_scheduler_bind_type_args(),
+	  %% Undocumented: the following is for 'debug_flags' that
+	  %% takes any erlang term as flags and currently ignores it.
+	  %% t_any(),	% commented out since it destroys the type signature
+	  %%
+	  %% Again undocumented; the following are for 'sequential_tracer'
+	  t_sequential_tracer(),
+	  %% The following two are for 'multi_scheduling'
+	  t_atom('block'),
+	  t_atom('unblock'),
+	  %% The following is for 'internal_cpu_topology'
+	  t_internal_cpu_topology()])];
+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()])])];
+arg_types(erlang, system_monitor, 0) ->
+  [];
+arg_types(erlang, system_monitor, 1) ->
+  [t_system_monitor_settings()];
+arg_types(erlang, system_monitor, 2) ->
+  [t_pid(), t_system_monitor_options()];
+arg_types(erlang, system_profile, 0) ->
+  [];
+arg_types(erlang, system_profile, 2) ->
+  [t_sup([t_pid(), t_port(), t_atom('undefined')]),
+   t_system_profile_options()];
+arg_types(erlang, term_to_binary, 1) ->
+  [t_any()];
+arg_types(erlang, term_to_binary, 2) ->
+  [t_any(), t_list(t_sup([t_atom('compressed'),
+			  t_tuple([t_atom('compressed'), t_from_range(0, 9)]),
+			  t_tuple([t_atom('minor_version'), t_integers([0, 1])])]))];
+arg_types(erlang, throw, 1) ->
+  [t_any()];
+arg_types(erlang, time, 0) ->
+  [];
+arg_types(erlang, tl, 1) ->
+  [t_cons()];
+arg_types(erlang, trace, 3) ->
+  [t_sup(t_pid(), t_sup([t_atom('existing'), t_atom('new'), t_atom('all')])),
+   t_boolean(),
+   t_list(t_sup(t_atom(), t_tuple(2)))];
+arg_types(erlang, trace_delivered, 1) ->
+  [t_sup(t_pid(), t_atom('all'))];
+arg_types(erlang, trace_info, 2) ->
+  [t_sup([%% the following two get info about a PID
+	  t_pid(), t_atom('new'),
+	  %% while the following two get info about a func
+	  t_mfa(), t_atom('on_load')]),
+   t_sup([%% the following are items about a PID
+	  t_atom('flags'), t_atom('tracer'),
+	  %% while the following are items about a func
+	  t_atom('traced'), t_atom('match_spec'), t_atom('meta'),
+	  t_atom('meta_match_spec'), t_atom('call_count'), t_atom('all')])];
+arg_types(erlang, trace_pattern, 2) ->
+  [t_sup(t_tuple([t_atom(), t_atom(), t_sup(t_arity(), t_atom('_'))]),
+	 t_atom('on_load')),
+   t_sup([t_boolean(), t_list(), t_atom('restart'), t_atom('pause')])];
+arg_types(erlang, trace_pattern, 3) ->
+  arg_types(erlang, trace_pattern, 2) ++
+    [t_list(t_sup([t_atom('global'), t_atom('local'),
+		   t_atom('meta'), t_tuple([t_atom('meta'), t_pid()]),
+		   t_atom('call_count')]))];
+arg_types(erlang, trunc, 1) ->
+  [t_number()];
+arg_types(erlang, tuple_size, 1) ->
+  [t_tuple()];
+arg_types(erlang, tuple_to_list, 1) ->
+  [t_tuple()];
+arg_types(erlang, universaltime, 0) ->
+  [];
+arg_types(erlang, universaltime_to_localtime, 1) ->
+  [t_tuple([t_date(), t_time()])];
+arg_types(erlang, unlink, 1) ->
+  [t_sup(t_pid(), t_port())];
+arg_types(erlang, unregister, 1) ->
+  [t_atom()];
+arg_types(erlang, whereis, 1) ->
+  [t_atom()];
+arg_types(erlang, yield, 0) ->
+  [];
+%%------- erl_prim_loader -----------------------------------------------------
+arg_types(erl_prim_loader, get_file, 1) ->
+  [t_sup(t_atom(), t_string())];
+arg_types(erl_prim_loader, get_path, 0) ->
+  [];
+arg_types(erl_prim_loader, set_path, 1) ->
+  [t_list(t_string())];
+%%------- error_logger --------------------------------------------------------
+arg_types(error_logger, warning_map, 0) ->
+  [];
+%%------- erts_debug ----------------------------------------------------------
+arg_types(erts_debug, breakpoint, 2) ->
+  [t_tuple([t_atom(), t_atom(), t_sup(t_integer(), t_atom('_'))]), t_boolean()];
+arg_types(erts_debug, disassemble, 1) ->
+  [t_sup(t_mfa(), t_integer())];
+arg_types(erts_debug, flat_size, 1) ->
+  [t_any()];
+arg_types(erts_debug, same, 2) ->
+  [t_any(), t_any()];
+%%------- ets -----------------------------------------------------------------
+arg_types(ets, all, 0) ->
+  [];
+arg_types(ets, delete, 1) ->
+  [t_tab()];
+arg_types(ets, delete, 2) ->
+  [t_tab(), t_any()];
+arg_types(ets, delete_all_objects, 1) ->
+  [t_tab()];
+arg_types(ets, delete_object, 2) ->
+  [t_tab(), t_tuple()];
+arg_types(ets, first, 1) ->
+  [t_tab()];
+arg_types(ets, give_away, 3) ->
+  [t_tab(), t_pid(), t_any()];
+arg_types(ets, info, 1) ->
+  [t_tab()];
+arg_types(ets, info, 2) ->
+  [t_tab(), t_ets_info_items()];
+arg_types(ets, insert, 2) ->
+  [t_tab(), t_sup(t_tuple(), t_list(t_tuple()))];
+arg_types(ets, insert_new, 2) ->
+  [t_tab(), t_sup(t_tuple(), t_list(t_tuple()))];
+arg_types(ets, is_compiled_ms, 1) ->
+  [t_any()];
+arg_types(ets, last, 1) ->
+  arg_types(ets, first, 1);
+arg_types(ets, lookup, 2) ->
+  [t_tab(), t_any()];
+arg_types(ets, lookup_element, 3) ->
+  [t_tab(), t_any(), t_pos_fixnum()];
+arg_types(ets, match, 1) ->
+  [t_any()];
+arg_types(ets, match, 2) ->
+  [t_tab(), t_match_pattern()];
+arg_types(ets, match, 3) ->
+  [t_tab(), t_match_pattern(), t_pos_fixnum()];
+arg_types(ets, match_object, 1) ->
+  arg_types(ets, match, 1);
+arg_types(ets, match_object, 2) ->
+  arg_types(ets, match, 2);
+arg_types(ets, match_object, 3) ->
+  arg_types(ets, match, 3);
+arg_types(ets, match_spec_compile, 1) ->
+  [t_matchspecs()];
+arg_types(ets, match_spec_run_r, 3) ->
+  [t_matchspecs(), t_any(), t_list()];
+arg_types(ets, member, 2) ->
+  [t_tab(), t_any()];
+arg_types(ets, new, 2) ->
+  [t_atom(), t_ets_new_options()];
+arg_types(ets, next, 2) ->
+  [t_tab(), t_any()];
+arg_types(ets, prev, 2) ->
+  [t_tab(), t_any()];
+arg_types(ets, rename, 2) ->
+  [t_atom(), t_atom()];
+arg_types(ets, safe_fixtable, 2) ->
+  [t_tab(), t_boolean()];
+arg_types(ets, select, 1) ->
+  [t_any()];
+arg_types(ets, select, 2) ->
+  [t_tab(), t_matchspecs()];
+arg_types(ets, select, 3) ->
+  [t_tab(), t_matchspecs(), t_pos_fixnum()];
+arg_types(ets, select_count, 2) ->
+  [t_tab(), t_matchspecs()];
+arg_types(ets, select_delete, 2) ->
+  [t_tab(), t_matchspecs()];
+arg_types(ets, select_reverse, 1) ->
+  arg_types(ets, select, 1);
+arg_types(ets, select_reverse, 2) ->
+  arg_types(ets, select, 2);
+arg_types(ets, select_reverse, 3) ->
+  arg_types(ets, select, 3);
+arg_types(ets, slot, 2) ->
+  [t_tab(), t_non_neg_fixnum()]; % 2nd arg can be 0
+arg_types(ets, setopts, 2) ->
+  Opt = t_sup(t_tuple([t_atom('heir'), t_pid(), t_any()]),
+	      t_tuple([t_atom('heir'), t_atom('none')])),
+  [t_tab(), t_sup(Opt, t_list(Opt))];
+arg_types(ets, update_counter, 3) ->
+  [t_tab(), t_any(), t_sup(t_integer(),
+			   t_sup(t_tuple([t_integer(), t_integer()]),
+				 t_tuple([t_integer(), t_integer(),
+					  t_integer(), t_integer()])))];
+arg_types(ets, update_element, 3) ->
+  PosValue = t_tuple([t_integer(), t_any()]),
+  [t_tab(), t_any(), t_sup(PosValue, t_list(PosValue))];
+%%------- file ----------------------------------------------------------------
+arg_types(file, close, 1) ->
+  [t_file_io_device()];
+arg_types(file, delete, 1) ->
+  [t_file_name()];
+arg_types(file, get_cwd, 0) ->
+  [];
+arg_types(file, make_dir, 1) ->
+  [t_file_name()];
+arg_types(file, open, 2) ->
+  [t_file_name(), t_list(t_file_open_option())];
+arg_types(file, read_file, 1) ->
+  [t_file_name()];
+arg_types(file, set_cwd, 1) ->
+  [t_file_name()];
+arg_types(file, write, 2) ->
+  [t_file_io_device(), t_iodata()];
+arg_types(file, write_file, 2) ->
+  [t_file_name(), t_sup(t_binary(), t_list())];
+%%------- gen_tcp -------------------------------------------------------------
+arg_types(gen_tcp, accept, 1) ->
+  [t_socket()];
+arg_types(gen_tcp, accept, 2) ->
+  [t_socket(), t_timeout()];
+arg_types(gen_tcp, connect, 3) ->
+  [t_gen_tcp_address(), t_gen_tcp_port(), t_list(t_gen_tcp_connect_option())];
+arg_types(gen_tcp, connect, 4) ->
+  arg_types(gen_tcp, connect, 3) ++ [t_timeout()];
+arg_types(gen_tcp, listen, 2) ->
+  [t_gen_tcp_port(), t_list(t_gen_tcp_listen_option())];
+arg_types(gen_tcp, recv, 2) ->
+  [t_socket(), t_non_neg_integer()];
+arg_types(gen_tcp, recv, 3) ->
+  arg_types(gen_tcp, recv, 2) ++ [t_timeout()];
+arg_types(gen_tcp, send, 2) ->
+  [t_socket(), t_packet()];
+arg_types(gen_tcp, shutdown, 2) ->
+  [t_socket(), t_sup([t_atom('read'), t_atom('write'), t_atom('read_write')])];
+%%------- gen_udp -------------------------------------------------------------
+arg_types(gen_udp, open, 1) ->
+  [t_gen_tcp_port()];
+arg_types(gen_udp, open, 2) ->
+  [t_gen_tcp_port(), t_list(t_gen_udp_connect_option())];
+arg_types(gen_udp, recv, 2) ->
+  arg_types(gen_tcp, recv, 2);
+arg_types(gen_udp, recv, 3) ->
+  arg_types(gen_tcp, recv, 3);
+arg_types(gen_udp, send, 4) ->
+  [t_socket(), t_gen_tcp_address(), t_gen_tcp_port(), t_packet()];
+%%------- 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_sup(t_atom('remote'), t_atom('local'))])];
+arg_types(hipe_bifs, alloc_data, 2) ->
+  [t_integer(), t_integer()];
+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_integer()];
+arg_types(hipe_bifs, enter_code, 2) ->
+  [t_binary(), t_sup(t_nil(), t_tuple())];
+arg_types(hipe_bifs, enter_sdesc, 1) ->
+  [t_tuple([t_integer(), t_integer(), t_integer(), t_integer(), t_integer()])];
+arg_types(hipe_bifs, find_na_or_make_stub, 2) ->
+  [t_mfa(), t_boolean()];
+arg_types(hipe_bifs, fun_to_address, 1) ->
+  [t_mfa()];
+%% arg_types(hipe_bifs, get_emu_address, 1) ->
+%%   [t_mfa()];
+arg_types(hipe_bifs, get_rts_param, 1) ->
+  [t_fixnum()];
+arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) ->
+  [t_list(t_mfa())];
+arg_types(hipe_bifs, make_fe, 3) ->
+  [t_integer(), t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])];
+%% arg_types(hipe_bifs, make_native_stub, 2) ->
+%%   [t_integer(), t_arity()];
+arg_types(hipe_bifs, mark_referred_from, 1) ->
+  [t_mfa()];
+arg_types(hipe_bifs, merge_term, 1) ->
+  [t_any()];
+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, redirect_referred_from, 1) ->
+  [t_mfa()];
+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, remove_refs_from, 1) ->
+  [t_mfa()];
+arg_types(hipe_bifs, set_funinfo_native_address, 3) ->
+  arg_types(hipe_bifs, set_native_address, 3);
+arg_types(hipe_bifs, set_native_address, 3) ->
+  [t_mfa(), t_integer(), t_boolean()];
+arg_types(hipe_bifs, system_crc, 1) ->
+  [t_integer()];
+arg_types(hipe_bifs, term_to_word, 1) ->
+  [t_any()];
+arg_types(hipe_bifs, update_code_size, 3) ->
+  [t_atom(), t_sup(t_nil(), t_binary()), t_integer()];
+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()];
+%%------- io ------------------------------------------------------------------
+arg_types(io, format, 1) ->
+  [t_io_format_string()];
+arg_types(io, format, 2) ->
+  [t_io_format_string(), t_list()];
+arg_types(io, format, 3) ->
+  [t_io_device(), t_io_format_string(), t_list()];
+arg_types(io, fwrite, 1) ->
+  arg_types(io, format, 1);
+arg_types(io, fwrite, 2) ->
+  arg_types(io, format, 2);
+arg_types(io, fwrite, 3) ->
+  arg_types(io, format, 3);
+arg_types(io, put_chars, 1) ->
+  [t_iodata()];
+arg_types(io, put_chars, 2) ->
+  [t_io_device(), t_iodata()];
+%%------- io_lib --------------------------------------------------------------
+arg_types(io_lib, format, 2) ->
+  arg_types(io, format, 2);
+arg_types(io_lib, fwrite, 2) ->
+  arg_types(io_lib, format, 2);
+%%------- 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, seq, 2) ->
+  [t_integer(), t_integer()];
+arg_types(lists, seq, 3) ->
+  [t_integer(), t_integer(), t_integer()];
+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()];
+%%------- math ----------------------------------------------------------------
+arg_types(math, acos, 1) ->
+  [t_number()];
+arg_types(math, acosh, 1) ->
+  [t_number()];
+arg_types(math, asin, 1) ->
+  [t_number()];
+arg_types(math, asinh, 1) ->
+  [t_number()];
+arg_types(math, atan, 1) ->
+  [t_number()];
+arg_types(math, atan2, 2) ->
+  [t_number(), t_number()];
+arg_types(math, atanh, 1) ->
+  [t_number()];
+arg_types(math, cos, 1) ->
+  [t_number()];
+arg_types(math, cosh, 1) ->
+  [t_number()];
+arg_types(math, erf, 1) ->
+  [t_number()];
+arg_types(math, erfc, 1) ->
+  [t_number()];
+arg_types(math, exp, 1) ->
+  [t_number()];
+arg_types(math, log, 1) ->
+  [t_number()];
+arg_types(math, log10, 1) ->
+  [t_number()];
+arg_types(math, pi, 0) ->
+  [];
+arg_types(math, pow, 2) ->
+  [t_number(), t_number()];
+arg_types(math, sin, 1) ->
+  [t_number()];
+arg_types(math, sinh, 1) ->
+  [t_number()];
+arg_types(math, sqrt, 1) ->
+  [t_number()];
+arg_types(math, tan, 1) ->
+  [t_number()];
+arg_types(math, tanh, 1) ->
+  [t_number()];
+%%-- net_kernel ---------------------------------------------------------------
+arg_types(net_kernel, dflag_unicode_io, 1) ->
+  [t_pid()];
+%%------- ordsets -------------------------------------------------------------
+arg_types(ordsets, filter, 2) ->
+  arg_types(lists, filter, 2);
+arg_types(ordsets, fold, 3) ->
+  arg_types(lists, foldl, 3);
+%%------- os ------------------------------------------------------------------
+arg_types(os, getenv, 0) ->
+  [];
+arg_types(os, getenv, 1) ->
+  [t_string()];
+arg_types(os, getpid, 0) ->
+  [];
+arg_types(os, putenv, 2) ->
+  [t_string(), t_string()];
+%%-- re -----------------------------------------------------------------------
+arg_types(re, compile, 1) ->
+  [t_iodata()];
+arg_types(re, compile, 2) ->
+  [t_iodata(), t_list(t_re_compile_option())];
+arg_types(re, run, 2) ->
+  [t_iodata(), t_re_RE()];
+arg_types(re, run, 3) ->
+  [t_iodata(), t_re_RE(), t_list(t_re_run_option())];
+%%------- string --------------------------------------------------------------
+arg_types(string, chars, 2) ->
+  [t_char(), t_non_neg_integer()];
+arg_types(string, chars, 3) ->
+  [t_char(), t_non_neg_integer(), t_any()];
+arg_types(string, concat, 2) ->
+  [t_string(), t_string()];
+arg_types(string, equal, 2) ->
+  [t_string(), t_string()];
+arg_types(string, to_float, 1) ->
+  [t_string()];
+arg_types(string, to_integer, 1) ->
+  [t_string()];
+%%------- unicode -------------------------------------------------------------
+arg_types(unicode, characters_to_binary, 2) ->
+  [t_ML(), t_encoding()];
+arg_types(unicode, characters_to_list, 2) ->
+  [t_ML(), t_encoding()];
+arg_types(unicode, bin_is_7bit, 1) ->
+  [t_binary()];
+%%-----------------------------------------------------------------------------
+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(atom(), atom(), arity()) -> boolean().
+
+is_known(M, F, A) ->
+  arg_types(M, F, A) =/= unknown.
+
+
+-spec structure_inspecting_args(atom(), atom(), arity()) -> [1..255].
+
+structure_inspecting_args(erlang, element, 2) -> [2];
+structure_inspecting_args(erlang, is_atom, 1) -> [1];
+structure_inspecting_args(erlang, is_boolean, 1) -> [1];
+structure_inspecting_args(erlang, is_binary, 1) -> [1];
+structure_inspecting_args(erlang, is_bitstring, 1) -> [1];
+structure_inspecting_args(erlang, is_float, 1) -> [1];
+structure_inspecting_args(erlang, is_function, 1) -> [1];
+structure_inspecting_args(erlang, is_integer, 1) -> [1];
+structure_inspecting_args(erlang, is_list, 1) -> [1];
+structure_inspecting_args(erlang, is_number, 1) -> [1];
+structure_inspecting_args(erlang, is_pid, 1) -> [1];
+structure_inspecting_args(erlang, is_port, 1) -> [1];
+structure_inspecting_args(erlang, is_reference, 1) -> [1];
+structure_inspecting_args(erlang, is_tuple, 1) -> [1];
+%%structure_inspecting_args(erlang, setelement, 3) -> [2].
+structure_inspecting_args(_, _, _) -> []. % XXX: assume no arg needs inspection
+
+
+check_fun_application(Fun, Args) ->
+  case t_is_fun(Fun) of
+    true ->
+      case t_fun_args(Fun) of
+	unknown ->
+	  case t_is_none_or_unit(t_fun_range(Fun)) of
+	    true -> error;
+	    false -> ok
+	  end;
+	FunDom when length(FunDom) =:= length(Args) ->
+	  case any_is_none_or_unit(inf_lists(FunDom, Args)) of
+	    true -> error;
+	    false ->
+	      case t_is_none_or_unit(t_fun_range(Fun)) of
+		true -> error;
+		false -> ok
+	      end
+	  end;
+	_ -> error
+      end;
+    false ->
+      error
+  end.
+
+
+%% =====================================================================
+%% These are basic types that should probably be moved to erl_types
+%% =====================================================================
+
+t_socket() -> t_port(). % alias
+
+t_ip_address() ->
+  T_int16 = t_from_range(0,  16#FFFF),
+  t_sup(t_tuple([t_byte(), t_byte(), t_byte(), t_byte()]),
+	t_tuple([T_int16, T_int16, T_int16, T_int16,
+		 T_int16, T_int16, T_int16, T_int16])).
+
+%% =====================================================================
+%% Some basic types used in various parts of the system
+%% =====================================================================
+
+t_date() ->
+  t_tuple([t_pos_fixnum(), t_pos_fixnum(), t_pos_fixnum()]).
+
+t_time() ->
+  t_tuple([t_non_neg_fixnum(), t_non_neg_fixnum(), t_non_neg_fixnum()]).
+
+t_packet() ->
+  t_sup([t_binary(), t_iolist(), t_httppacket()]).
+
+t_httppacket() ->
+  t_sup([t_HttpRequest(), t_HttpResponse(),
+	 t_HttpHeader(), t_atom('http_eoh'), t_HttpError()]).
+
+%% =====================================================================
+%% HTTP types documented in R12B-4
+%% =====================================================================
+
+t_HttpRequest() ->
+  t_tuple([t_atom('http_request'), t_HttpMethod(), t_HttpUri(), t_HttpVersion()]).
+
+t_HttpResponse() ->
+   t_tuple([t_atom('http_response'), t_HttpVersion(), t_integer(), t_string()]).
+
+t_HttpHeader() ->
+  t_tuple([t_atom('http_header'), t_integer(), t_HttpField(), t_any(), t_string()]).
+
+t_HttpError() ->
+  t_tuple([t_atom('http_error'), t_string()]).
+
+t_HttpMethod() ->
+  t_sup(t_HttpMethodAtom(), t_string()).
+
+t_HttpMethodAtom() ->
+  t_atoms(['OPTIONS', 'GET', 'HEAD', 'POST', 'PUT', 'DELETE', 'TRACE']).
+
+t_HttpUri() ->
+  t_sup([t_atom('*'),
+	 t_tuple([t_atom('absoluteURI'),
+		  t_sup(t_atom('http'), t_atom('https')),
+		  t_string(),
+		  t_sup(t_non_neg_integer(), t_atom('undefined')),
+		  t_string()]),
+	 t_tuple([t_atom('scheme'), t_string(), t_string()]),
+	 t_tuple([t_atom('abs_path'), t_string()]),
+	 t_string()]).
+
+t_HttpVersion() ->
+  t_tuple([t_non_neg_integer(), t_non_neg_integer()]).
+
+t_HttpField() ->
+  t_sup(t_HttpFieldAtom(), t_string()).
+
+t_HttpFieldAtom() ->
+  t_atoms(['Cache-Control', 'Connection', 'Date', 'Pragma', 'Transfer-Encoding',
+	   'Upgrade', 'Via', 'Accept', 'Accept-Charset', 'Accept-Encoding',
+	   'Accept-Language', 'Authorization', 'From', 'Host',
+	   'If-Modified-Since', 'If-Match', 'If-None-Match', 'If-Range',
+	   'If-Unmodified-Since', 'Max-Forwards', 'Proxy-Authorization',
+	   'Range', 'Referer', 'User-Agent', 'Age', 'Location',
+	   'Proxy-Authenticate', 'Public', 'Retry-After', 'Server', 'Vary',
+	   'Warning', 'Www-Authenticate', 'Allow', 'Content-Base',
+	   'Content-Encoding', 'Content-Language', 'Content-Length',
+	   'Content-Location', 'Content-Md5', 'Content-Range', 'Content-Type',
+	   'Etag', 'Expires', 'Last-Modified', 'Accept-Ranges',
+	   'Set-Cookie', 'Set-Cookie2', 'X-Forwarded-For', 'Cookie',
+	   'Keep-Alive', 'Proxy-Connection']).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'code'
+%% =====================================================================
+
+t_code_load_return(Mod) ->
+  t_sup(t_tuple([t_atom('module'), case t_is_atom(Mod) of
+				     true -> Mod;
+				     false -> t_atom()
+				   end]),
+	t_tuple([t_atom('error'), t_code_load_error_rsn()])).
+
+t_code_load_error_rsn() ->	% also used in erlang:load_module/2
+  t_sup([t_atom('badfile'),
+	 t_atom('nofile'),
+	 t_atom('not_purged'),
+	 t_atom('native_code'),
+	 t_atom('sticky_directory')]).	% only for the 'code' functions
+
+t_code_loaded_fname_or_status() ->
+  t_sup([t_string(), % filename
+	 t_atom('preloaded'),
+	 t_atom('cover_compiled')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'erlang'
+%% =====================================================================
+
+t_decode_packet_option() ->
+  t_sup([t_tuple([t_atom('packet_size'), t_non_neg_integer()]),
+	 t_tuple([t_atom('line_length'), t_non_neg_integer()])]).
+
+t_decode_packet_type() ->
+  t_sup(t_inet_setoption_packettype(), t_atom('httph')).
+
+t_dist_exit() ->
+  t_sup([t_atom('kill'), t_atom('noconnection'), t_atom('normal')]).
+
+t_match_spec_test_errors() ->
+  t_list(t_sup(t_tuple([t_atom('error'), t_string()]),
+	       t_tuple([t_atom('warning'), t_string()]))).
+
+t_module_info_2() ->
+ t_sup([t_atom('module'),
+	t_atom('imports'),
+	t_atom('exports'),
+	t_atom('functions'),
+	t_atom('attributes'),
+	t_atom('compile'),
+	t_atom('native_addresses')]).
+
+t_pinfo() ->
+  t_sup([t_pinfo_item(), t_list(t_pinfo_item())]).
+
+t_pinfo_item() ->
+  t_sup([t_atom('backtrace'),
+	 t_atom('current_function'),
+	 t_atom('dictionary'),
+	 t_atom('error_handler'),
+	 t_atom('garbage_collection'),
+	 t_atom('group_leader'),
+	 t_atom('heap_size'),
+	 t_atom('initial_call'),
+	 t_atom('last_calls'),
+	 t_atom('links'),
+	 t_atom('memory'),
+	 t_atom('message_binary'),     % for hybrid heap only
+	 t_atom('message_queue_len'),
+	 t_atom('messages'),
+	 t_atom('monitored_by'),
+	 t_atom('monitors'),
+	 t_atom('priority'),
+	 t_atom('reductions'),
+	 t_atom('registered_name'),
+	 t_atom('sequential_trace_token'),
+	 t_atom('stack_size'),
+	 t_atom('status'),
+	 t_atom('suspending'),
+	 t_atom('total_heap_size'),
+	 t_atom('trap_exit')]).
+
+t_process_priority_level() ->
+  t_sup([t_atom('max'), t_atom('high'), t_atom('normal'), t_atom('low')]).
+
+t_process_status() ->
+  t_sup([t_atom('runnable'), t_atom('running'),
+	 t_atom('suspended'), t_atom('waiting')]).
+
+t_raise_errorclass() ->
+  t_sup([t_atom('error'), t_atom('exit'), t_atom('throw')]).
+
+t_sendoptions() ->
+  t_sup(t_atom('noconnect'), t_atom('nosuspend')).
+
+t_seq_trace_info() ->
+  t_sup([t_atom('send'),
+	 t_atom('receive'),
+	 t_atom('print'),
+	 t_atom('timestamp'),
+	 t_atom('label'),
+	 t_atom('serial')]).
+
+%% XXX: Better if we also maintain correspondencies between infos and values
+t_seq_trace_info_returns() ->
+  Values = t_sup([t_non_neg_integer(), t_boolean(),
+		  t_tuple([t_non_neg_integer(), t_non_neg_integer()])]),
+  t_sup(t_tuple([t_seq_trace_info(), Values]), t_nil()).
+
+t_sequential_tracer() ->
+  t_sup([t_atom('false'), t_pid(), t_port()]).
+
+t_spawn_options() ->
+  t_sup([t_atom('link'),
+	 t_atom('monitor'),
+	 t_tuple([t_atom('priority'), t_process_priority_level()]),
+	 t_tuple([t_atom('min_heap_size'), t_fixnum()]),
+	 t_tuple([t_atom('fullsweep_after'), t_fixnum()])]).
+
+t_spawn_opt_return(List) ->
+  case t_is_none(t_inf(t_list(t_atom('monitor')), List)) of
+    true -> t_pid();
+    false -> t_sup(t_pid(), t_tuple([t_pid(), t_reference()]))
+  end.
+
+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_args() ->
+  t_sup([t_atom('default_bind'),
+	 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_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_monitor_settings() ->
+  t_sup([t_atom('undefined'),
+	 t_tuple([t_pid(), t_system_monitor_options()])]).
+
+t_system_monitor_options() ->
+  t_list(t_sup([t_atom('busy_port'),
+		t_atom('busy_dist_port'),
+		t_tuple([t_atom('long_gc'), t_integer()]),
+		t_tuple([t_atom('large_heap'), t_integer()])])).
+
+t_system_multi_scheduling() ->
+  t_sup([t_atom('blocked'), t_atom('disabled'), t_atom('enabled')]).
+
+t_system_profile_options() ->
+  t_list(t_sup([t_atom('exclusive'),
+		t_atom('runnable_ports'),
+		t_atom('runnable_procs'),
+		t_atom('scheduler')])).
+
+t_system_profile_return() ->
+  t_sup(t_atom('undefined'),
+	t_tuple([t_sup(t_pid(), t_port()), t_system_profile_options()])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'ets'
+%% =====================================================================
+
+t_tab() ->
+  t_sup(t_tid(), t_atom()).
+
+t_match_pattern() ->
+  t_sup(t_atom(), t_tuple()).
+
+t_matchspecs() ->
+  t_list(t_tuple([t_match_pattern(), t_list(), t_list()])).
+
+t_matchres() ->
+  t_sup(t_tuple([t_list(), t_any()]), t_atom('$end_of_table')).
+
+%% From the 'ets' documentation
+%%-----------------------------
+%%   Option = Type | Access | named_table | {keypos,Pos}
+%%          | {heir,pid(),HeirData} | {heir,none}
+%%          | {write_concurrency,boolean()}
+%%     Type = set | ordered_set | bag | duplicate_bag
+%%   Access = public | protected | private
+%%      Pos = integer()
+%% HeirData = term()
+t_ets_new_options() ->
+  t_list(t_sup([t_atom('set'),
+		t_atom('ordered_set'),
+		t_atom('bag'),
+		t_atom('duplicate_bag'),
+		t_atom('public'),
+		t_atom('protected'),
+		t_atom('private'),
+		t_atom('named_table'),
+		t_tuple([t_atom('heir'), t_pid(), t_any()]),
+		t_tuple([t_atom('heir'), t_atom('none')]),
+		t_tuple([t_atom('keypos'), t_integer()]),
+		t_tuple([t_atom('write_concurrency'), t_boolean()])])).
+
+t_ets_info_items() ->
+  t_sup([t_atom('fixed'),
+	 t_atom('safe_fixed'),
+	 t_atom('keypos'),
+	 t_atom('memory'),
+	 t_atom('name'),
+	 t_atom('named_table'),
+	 t_atom('node'),
+	 t_atom('owner'),
+	 t_atom('protection'),
+	 t_atom('size'),
+	 t_atom('type')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'file'
+%% =====================================================================
+
+t_file_io_device() ->
+  t_sup(t_pid(), t_tuple([t_atom('file_descriptor'), t_atom(), t_any()])).
+
+t_file_name() ->
+  t_sup([t_atom(),
+	 t_string(),
+	 %% DeepList = [char() | atom() | DeepList] -- approximation below
+	 t_list(t_sup([t_atom(), t_string(), t_list()]))]).
+
+t_file_open_option() ->
+  t_sup([t_atom('read'),
+	 t_atom('write'),
+	 t_atom('append'),
+	 t_atom('raw'),
+	 t_atom('binary'),
+	 t_atom('delayed_write'),
+	 t_atom('read_ahead'),
+	 t_atom('compressed'),
+	 t_tuple([t_atom('delayed_write'),
+		  t_pos_integer(), t_non_neg_integer()]),
+	 t_tuple([t_atom('read_ahead'), t_pos_integer()])]).
+
+%% This lists all Posix errors that can occur in file:*/* functions
+t_file_posix_error() ->
+  t_sup([t_atom('eacces'),
+	 t_atom('eagain'),
+	 t_atom('ebadf'),
+	 t_atom('ebusy'),
+	 t_atom('edquot'),
+	 t_atom('eexist'),
+	 t_atom('efault'),
+	 t_atom('efbig'),
+	 t_atom('eintr'),
+	 t_atom('einval'),
+	 t_atom('eio'),
+	 t_atom('eisdir'),
+	 t_atom('eloop'),
+	 t_atom('emfile'),
+	 t_atom('emlink'),
+	 t_atom('enametoolong'),
+	 t_atom('enfile'),
+	 t_atom('enodev'),
+	 t_atom('enoent'),
+	 t_atom('enomem'),
+	 t_atom('enospc'),
+	 t_atom('enotblk'),
+	 t_atom('enotdir'),
+	 t_atom('enotsup'),
+	 t_atom('enxio'),
+	 t_atom('eperm'),
+	 t_atom('epipe'),
+	 t_atom('erofs'),
+	 t_atom('espipe'),
+	 t_atom('esrch'),
+	 t_atom('estale'),
+	 t_atom('exdev')]).
+
+t_file_return() ->
+  t_sup(t_atom('ok'), t_tuple([t_atom('error'), t_file_posix_error()])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'gen_tcp'
+%% =====================================================================
+
+t_gen_tcp_accept() ->
+  t_sup(t_tuple([t_atom('ok'), t_socket()]),
+	t_tuple([t_atom('error'), t_sup([t_atom('closed'),
+					 t_atom('timeout'),
+					 t_inet_posix_error()])])).
+
+t_gen_tcp_address() ->
+  t_sup([t_string(), t_atom(), t_ip_address()]).
+
+t_gen_tcp_port() ->
+  t_from_range(0, 16#FFFF).
+
+t_gen_tcp_connect_option() ->
+  t_sup([t_atom('list'),
+	 t_atom('binary'),
+	 t_tuple([t_atom('ip'), t_ip_address()]),
+	 t_tuple([t_atom('port'), t_gen_tcp_port()]),
+	 t_tuple([t_atom('fd'), t_integer()]),
+	 t_atom('inet6'),
+	 t_atom('inet'),
+	 t_inet_setoption()]).
+
+t_gen_tcp_listen_option() ->
+  t_sup([t_atom('list'),
+	 t_atom('binary'),
+	 t_tuple([t_atom('backlog'), t_non_neg_integer()]),
+	 t_tuple([t_atom('ip'), t_ip_address()]),
+	 t_tuple([t_atom('fd'), t_integer()]),
+	 t_atom('inet6'),
+	 t_atom('inet'),
+	 t_inet_setoption()]).
+
+t_gen_tcp_recv() ->
+  t_sup(t_tuple([t_atom('ok'), t_packet()]),
+	t_tuple([t_atom('error'), t_sup([t_atom('closed'),
+					 t_inet_posix_error()])])).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'gen_udp'
+%% =====================================================================
+
+t_gen_udp_connect_option() ->
+  t_sup([t_atom('list'),
+	 t_atom('binary'),
+	 t_tuple([t_atom('ip'), t_ip_address()]),
+	 t_tuple([t_atom('fd'), t_integer()]),
+	 t_atom('inet6'),
+	 t_atom('inet'),
+	 t_inet_setoption()]).
+
+t_gen_udp_recv() ->
+  t_sup(t_tuple([t_atom('ok'),
+		 t_tuple([t_ip_address(),
+			  t_gen_tcp_port(),
+			  t_packet()])]),
+	t_tuple([t_atom('error'),
+		 t_sup(t_atom('not_owner'), t_inet_posix_error())])).
+
+%% =====================================================================
+%% 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')]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'inet'
+%% =====================================================================
+
+t_inet_setoption() ->
+  t_sup([%% first the 2-tuple options
+	 t_tuple([t_atom('active'), t_sup(t_boolean(), t_atom('once'))]),
+	 t_tuple([t_atom('broadcast'), t_boolean()]),
+	 t_tuple([t_atom('delay_send'), t_boolean()]),
+	 t_tuple([t_atom('dontroute'), t_boolean()]),
+	 t_tuple([t_atom('exit_on_close'), t_boolean()]),
+	 t_tuple([t_atom('header'), t_non_neg_integer()]),
+	 t_tuple([t_atom('keepalive'), t_boolean()]),
+	 t_tuple([t_atom('nodelay'), t_boolean()]),
+	 t_tuple([t_atom('packet'), t_inet_setoption_packettype()]),
+	 t_tuple([t_atom('packet_size'), t_non_neg_integer()]),
+	 t_tuple([t_atom('read_packets'), t_non_neg_integer()]),
+	 t_tuple([t_atom('recbuf'), t_non_neg_integer()]),
+	 t_tuple([t_atom('reuseaddr'), t_boolean()]),
+	 t_tuple([t_atom('send_timeout'), t_non_neg_integer()]),
+	 t_tuple([t_atom('sndbuf'), t_non_neg_integer()]),
+	 t_tuple([t_atom('priority'), t_non_neg_integer()]),
+	 t_tuple([t_atom('tos'), t_non_neg_integer()]),
+	 %% and a 4-tuple option
+	 t_tuple([t_atom('raw'),
+		  t_non_neg_integer(),	% protocol level
+		  t_non_neg_integer(),	% option number
+		  t_binary()])]).	% actual option value
+
+t_inet_setoption_packettype() ->
+  t_sup([t_atom('raw'),
+	 t_integers([0,1,2,4]),
+	 t_atom('asn1'), t_atom('cdr'), t_atom('sunrm'),
+	 t_atom('fcgi'), t_atom('tpkt'), t_atom('line'),
+	 t_atom('http')]).	%% but t_atom('httph') is not needed
+
+t_inet_posix_error() ->
+  t_atom().  %% XXX: Very underspecified
+
+%% =====================================================================
+%% These are used for the built-in functions of 'io'
+%% =====================================================================
+
+t_io_device() ->
+  t_sup(t_atom(), t_pid()).
+
+%% The documentation in R11B-4 reads
+%%	Format ::= atom() | string() | binary()
+%% but the Format can also be a (deep) list, hence the type below
+t_io_format_string() ->
+  t_sup([t_atom(), t_list(), t_binary()]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 're'; the functions
+%% whose last name component starts with a capital letter are types
+%% =====================================================================
+
+t_re_MP() ->  %% it's supposed to be an opaque data type
+  t_tuple([t_atom('re_pattern'), t_integer(), t_integer(), t_binary()]).
+
+t_re_RE() ->
+  t_sup(t_re_MP(), t_iodata()).
+
+t_re_compile_option() ->
+  t_sup([t_atoms(['anchored', 'caseless', 'dollar_endonly', 'dotall',
+		  'extended', 'firstline', 'multiline', 'no_auto_capture',
+		  'dupnames', 'ungreedy']),
+	 t_tuple([t_atom('newline'), t_re_NLSpec()])]).
+
+t_re_run_option() ->
+  t_sup([t_atoms(['anchored', 'global', 'notbol', 'noteol', 'notempty']),
+	 t_tuple([t_atom('offset'), t_integer()]),
+	 t_tuple([t_atom('newline'), t_re_NLSpec()]),
+	 t_tuple([t_atom('capture'), t_re_ValueSpec()]),
+	 t_tuple([t_atom('capture'), t_re_ValueSpec(), t_re_Type()]),
+	 t_re_compile_option()]).
+
+t_re_ErrorSpec() ->
+  t_tuple([t_string(), t_non_neg_integer()]).
+
+t_re_Type() ->
+  t_atoms(['index', 'list', 'binary']).
+
+t_re_NLSpec() ->
+  t_atoms(['cr', 'crlf', 'lf', 'anycrlf']).
+
+t_re_ValueSpec() ->
+  t_sup(t_atoms(['all', 'all_but_first', 'first', 'none']), t_re_ValueList()).
+
+t_re_ValueList() ->
+  t_list(t_sup([t_integer(), t_string(), t_atom()])).
+
+t_re_Captured() ->
+  t_list(t_sup(t_re_CapturedData(), t_list(t_re_CapturedData()))).
+
+t_re_CapturedData() ->
+  t_sup([t_tuple([t_integer(), t_integer()]), t_string(), t_binary()]).
+
+%% =====================================================================
+%% These are used for the built-in functions of 'unicode'
+%% =====================================================================
+
+t_ML() ->     % a binary or a possibly deep list of integers or binaries
+  t_sup(t_list(t_sup([t_integer(), t_binary(), t_list()])), t_binary()).
+
+t_encoding() ->
+  t_atoms(['latin1', 'unicode', 'utf8', 'utf16', 'utf32']).
+
+t_encoding_a2b() -> % for the 2nd arg of atom_to_binary/2 and binary_to_atom/2
+  t_atoms(['latin1', 'unicode', 'utf8']).
+
+%% =====================================================================
+%% 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/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
new file mode 100644
index 0000000000..fac308d0c6
--- /dev/null
+++ b/lib/hipe/cerl/erl_types.erl
@@ -0,0 +1,3847 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+%% ======================================================================
+%% Copyright (C) 2000-2003 Richard Carlsson
+%%
+%% ======================================================================
+%% 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 added spec declarations.
+%%
+%% Author contact: [email protected], [email protected], [email protected]
+%% ======================================================================
+
+-module(erl_types).
+
+-export([any_none/1,
+	 any_none_or_unit/1,
+	 lookup_record/3,
+	 max/2,
+	 module_builtin_opaques/1,
+	 min/2,
+	 number_max/1,
+	 number_min/1,
+	 t_abstract_records/2,
+	 t_any/0,
+	 t_arity/0,
+	 t_atom/0,
+	 t_atom/1,
+	 t_atoms/1,
+	 t_atom_vals/1,
+	 t_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_boolean/0,
+	 t_byte/0,
+	 t_char/0,
+	 t_collect_vars/1,
+	 t_cons/0,
+	 t_cons/2,
+	 t_cons_hd/1,
+	 t_cons_tl/1,
+	 t_constant/0,
+	 t_contains_opaque/1,
+	 t_elements/1,
+	 t_find_opaque_mismatch/2,
+	 t_fixnum/0,
+	 t_map/2,
+	 t_non_neg_fixnum/0,
+	 t_pos_fixnum/0,
+	 t_float/0,
+	 t_form_to_string/1,
+	 t_from_form/1,
+	 t_from_form/2,
+	 t_from_form/3,
+	 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_arity/1,
+	 t_fun_range/1,
+	 t_has_opaque_subtype/1,
+	 t_has_var/1,
+	 t_identifier/0,
+	 %% t_improper_list/2,
+	 t_inf/2,
+	 t_inf/3,
+	 t_inf_lists/2,
+	 t_inf_lists/3,
+	 t_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_binary/1,
+	 t_is_bitstr/1,
+	 t_is_bitwidth/1,
+	 t_is_boolean/1,
+	 %% t_is_byte/1,
+	 %% t_is_char/1,
+	 t_is_cons/1,
+	 t_is_constant/1,
+	 t_is_equal/2,
+	 t_is_fixnum/1,
+	 t_is_float/1,
+	 t_is_fun/1,
+	 t_is_instance/2,
+	 t_is_integer/1,
+	 t_is_list/1,
+	 t_is_matchstate/1,
+	 t_is_nil/1,
+	 t_is_non_neg_integer/1,
+	 t_is_none/1,
+	 t_is_none_or_unit/1,
+	 t_is_number/1,
+	 t_is_opaque/1,
+	 t_is_pid/1,
+	 t_is_port/1,
+	 t_is_maybe_improper_list/1,
+	 t_is_reference/1,
+	 t_is_remote/1,
+	 t_is_string/1,
+	 t_is_subtype/2,
+	 t_is_tuple/1,
+	 t_is_unit/1,
+	 t_is_var/1,
+	 t_limit/2,
+	 t_list/0,
+	 t_list/1,
+	 t_list_elements/1,
+	 t_list_termination/1,
+	 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_opaque_from_records/1,
+	 t_opaque_match_atom/2,
+	 t_opaque_match_record/2,
+	 t_opaque_matching_structure/2,
+	 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_remote/3,
+	 t_string/0,
+	 t_struct_from_opaque/2,
+	 t_solve_remote/2,
+	 t_subst/2,
+	 t_subtract/2,
+	 t_subtract_list/2,
+	 t_sup/1,
+	 t_sup/2,
+	 t_tid/0,
+	 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_size/1,
+	 t_tuple_sizes/1,
+	 t_tuple_subtypes/1,
+	 t_unify/2,
+	 t_unit/0,
+	 t_unopaque/1,
+	 t_unopaque/2,
+	 t_var/1,
+	 t_var_name/1,
+	 %% t_assign_variables_to_subtype/2,
+	 type_is_defined/3,
+	 subst_all_vars_to_any/1,
+	 lift_list_to_pos_empty/1
+	]).
+
+%%-define(DO_ERL_TYPES_TEST, true).
+
+-ifdef(DO_ERL_TYPES_TEST).
+-export([test/0]).
+-else.
+-define(NO_UNUSED, true).
+-endif.
+
+-ifndef(NO_UNUSED).
+-export([t_is_identifier/1]).
+-endif.
+
+%%=============================================================================
+%%
+%% Definition of the type structure
+%%
+%%=============================================================================
+
+%%-----------------------------------------------------------------------------
+%% Limits
+%%
+
+-define(TUPLE_TAG_LIMIT, 5).
+-define(TUPLE_ARITY_LIMIT, 10).
+-define(SET_LIMIT, 13).
+-define(MAX_BYTE, 255).
+-define(MAX_CHAR, 16#10ffff).
+
+-define(WIDENING_LIMIT, 7).
+-define(UNIT_MULTIPLIER, 8).
+
+-define(TAG_IMMED1_SIZE, 4).
+-define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE).
+
+%%-----------------------------------------------------------------------------
+%% 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(matchstate_tag, matchstate).
+-define(nil_tag,        nil).
+-define(number_tag,     number).
+-define(opaque_tag,     opaque).
+-define(product_tag,    product).
+-define(remote_tag,     remote).
+-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 | ?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() :: {atom(), _, _} | {atom(), _, _, _}. %% XXX: Temporarily
+-type rng_elem()   :: 'pos_inf' | 'neg_inf' | integer().
+
+-record(int_set, {set :: [integer()]}).
+-record(int_rng, {from :: rng_elem(), to :: rng_elem()}).
+-record(opaque,  {mod :: module(), name :: atom(),
+		  args = [] :: [erl_type()], struct :: erl_type()}).
+-record(remote,  {mod:: module(), name :: atom(), args = [] :: [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(opaque(Optypes),           #c{tag=?opaque_tag, elements=Optypes}).
+-define(product(Types),            #c{tag=?product_tag, elements=Types}).
+-define(remote(RemTypes),          #c{tag=?remote_tag, elements=RemTypes}).
+-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)).
+
+%%-----------------------------------------------------------------------------
+%% 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(remote_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(?any) -> true;
+t_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) ->
+  ?opaque(set_singleton(#opaque{mod=Mod, name=Name, args=Args, struct=Struct})).
+
+-spec t_is_opaque(erl_type()) -> boolean().
+
+t_is_opaque(?opaque(_)) -> true;
+t_is_opaque(_) -> false.
+
+-spec t_has_opaque_subtype(erl_type()) -> boolean().
+
+t_has_opaque_subtype(?union(Ts)) ->
+  lists:any(fun t_is_opaque/1, Ts);
+t_has_opaque_subtype(T) ->
+  t_is_opaque(T).
+
+-spec t_opaque_structure(erl_type()) -> erl_type().
+
+t_opaque_structure(?opaque(Elements)) ->
+  case ordsets:size(Elements) of
+    1 ->
+      [#opaque{struct = Struct}] = ordsets:to_list(Elements),
+      Struct;
+    _ -> throw({error, "Unexpected multiple opaque types"})
+  end.
+
+-spec t_opaque_module(erl_type()) -> module().
+
+t_opaque_module(?opaque(Elements)) ->
+  case ordsets:size(Elements) of
+    1 ->
+      [#opaque{mod=Module}] = ordsets:to_list(Elements),
+      Module;
+    _ -> throw({error, "Unexpected multiple opaque types"})
+  end.
+
+%% This only makes sense if we know that Type matches Opaque
+-spec t_opaque_matching_structure(erl_type(), erl_type()) -> erl_type().
+
+t_opaque_matching_structure(Type, Opaque) ->
+  OpaqueStruct = t_opaque_structure(Opaque),
+  case OpaqueStruct of
+    ?union(L1) ->
+      case Type of
+	?union(_L2) -> OpaqueStruct;
+	_OtherType -> t_opaque_matching_structure_list(Type, L1)
+      end;
+    ?tuple_set(_Set1) = TupleSet ->
+      case Type of
+	?tuple_set(_Set2) -> OpaqueStruct;
+	_ -> t_opaque_matching_structure_list(Type, t_tuple_subtypes(TupleSet))
+      end;
+    _Other -> OpaqueStruct
+  end.
+
+t_opaque_matching_structure_list(Type, List) ->
+  NewList = [t_inf(Element, Type) || Element <- List],
+  Results = [NotNone || NotNone <- NewList, NotNone =/= ?none],
+  case Results of
+    [] -> ?none;
+    [First|_] -> First
+  end.
+
+-spec t_contains_opaque(erl_type()) -> boolean().
+
+t_contains_opaque(?any)                     -> false;
+t_contains_opaque(?none)                    -> false;
+t_contains_opaque(?unit)                    -> false;
+t_contains_opaque(?atom(_Set))              -> false;
+t_contains_opaque(?bitstr(_Unit, _Base))    -> false;
+t_contains_opaque(?float)                   -> false;
+t_contains_opaque(?function(Domain, Range)) ->
+  t_contains_opaque(Domain) orelse t_contains_opaque(Range);
+t_contains_opaque(?identifier(_Types))      -> false;
+t_contains_opaque(?integer(_Types))         -> false;
+t_contains_opaque(?int_range(_From, _To))   -> false;
+t_contains_opaque(?int_set(_Set))           -> false;
+t_contains_opaque(?list(Type, _, _))        -> t_contains_opaque(Type);
+t_contains_opaque(?matchstate(_P, _Slots))  -> false;
+t_contains_opaque(?nil)                     -> false;
+t_contains_opaque(?number(_Set, _Tag))      -> false;
+t_contains_opaque(?opaque(_))               -> true;
+t_contains_opaque(?product(Types))          -> list_contains_opaque(Types);
+t_contains_opaque(?tuple(?any, _, _))       -> false;
+t_contains_opaque(?tuple(Types, _, _))      -> list_contains_opaque(Types);
+t_contains_opaque(?tuple_set(_Set) = T)     ->
+  list_contains_opaque(t_tuple_subtypes(T));
+t_contains_opaque(?union(List))             -> list_contains_opaque(List);
+t_contains_opaque(?var(_Id))                -> false.
+
+-spec list_contains_opaque([erl_type()]) -> boolean().
+
+list_contains_opaque(List) ->
+  lists:any(fun t_contains_opaque/1, List).
+
+%% t_find_opaque_mismatch/2 of two types should only be used if their
+%% t_inf is t_none() due to some opaque type violation.
+%%
+%% 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()) -> 'error' | {'ok', erl_type(), erl_type()}.
+
+t_find_opaque_mismatch(T1, T2) ->
+  t_find_opaque_mismatch(T1, T2, T2).
+
+t_find_opaque_mismatch(?any, _Type, _TopType) -> error;
+t_find_opaque_mismatch(?none, _Type, _TopType) -> error;
+t_find_opaque_mismatch(?list(T1, _, _), ?list(T2, _, _), TopType) ->
+  t_find_opaque_mismatch(T1, T2, TopType);
+t_find_opaque_mismatch(_T1, ?opaque(_) = T2, TopType) -> {ok, TopType, T2};
+t_find_opaque_mismatch(?product(T1), ?product(T2), TopType) ->
+  t_find_opaque_mismatch_ordlists(T1, T2, TopType);
+t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), TopType) ->
+  t_find_opaque_mismatch_ordlists(T1, T2, TopType);
+t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, TopType) ->
+  Tuples1 = t_tuple_subtypes(T1),
+  Tuples2 = t_tuple_subtypes(T2),
+  t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType);
+t_find_opaque_mismatch(T1, ?union(U2), TopType) ->
+  t_find_opaque_mismatch_lists([T1], U2, TopType);
+t_find_opaque_mismatch(_T1, _T2, _TopType) -> error.
+
+t_find_opaque_mismatch_ordlists(L1, L2, TopType) ->
+  List = lists:zipwith(fun(T1, T2) ->
+			   t_find_opaque_mismatch(T1, T2, TopType)
+		       end, L1, L2),
+  t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_lists(L1, L2, _TopType) ->
+  List = [t_find_opaque_mismatch(T1, T2, T2) || T1 <- L1, T2 <- L2],
+  t_find_opaque_mismatch_list(List).
+
+t_find_opaque_mismatch_list([]) -> 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_opaque_from_records(dict()) -> [erl_type()].
+
+t_opaque_from_records(RecDict) ->
+  OpaqueRecDict =
+    dict:filter(fun(Key, _Value) ->
+		    case Key of
+		      {opaque, _Name} -> true;
+		      _  -> false
+		    end
+		end, RecDict),
+  OpaqueTypeDict =
+    dict:map(fun({opaque, Name}, {Module, Type, ArgNames}) ->
+		 case ArgNames of
+		   [] ->
+		     t_opaque(Module, Name, [], t_from_form(Type, RecDict));
+		   _ ->
+		     throw({error,"Polymorphic opaque types not supported yet"})
+		 end
+	     end, OpaqueRecDict),
+  [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)].
+
+-spec t_opaque_match_atom(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_opaque_match_atom(?atom(_) = Atom,  Opaques) ->
+  case t_atom_vals(Atom) of
+    unknown -> [];
+    _  -> [O || O <- Opaques, t_inf(Atom, O, opaque) =/= ?none,
+		t_opaque_atom_vals(t_opaque_structure(O)) =/= unknown]
+  end;
+t_opaque_match_atom(_, _) -> [].
+
+-spec t_opaque_atom_vals(erl_type()) -> 'unknown' | [atom(),...].
+
+t_opaque_atom_vals(OpaqueStruct) ->
+  case OpaqueStruct of
+    ?atom(_) -> t_atom_vals(OpaqueStruct);
+    ?union([Atom,_,_,_,_,_,_,_,_,_]) -> t_atom_vals(Atom);
+    _ -> unknown
+  end.
+	  
+-spec t_opaque_match_record(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_opaque_match_record(?tuple([?atom(_) = Tag|_Fields], _, _) = Rec, Opaques) ->
+  [O || O <- Opaques, t_inf(Rec, O, opaque) =/= ?none,
+	lists:member(Tag, t_opaque_tuple_tags(t_opaque_structure(O)))];
+t_opaque_match_record(_, _) -> [].
+
+-spec t_opaque_tuple_tags(erl_type()) -> [erl_type()].
+
+t_opaque_tuple_tags(OpaqueStruct) ->
+  case OpaqueStruct of
+    ?tuple([?atom(_) = Tag|_Fields], _, _) -> [Tag];
+    ?tuple_set(_) = TupleSet ->
+      Tuples = t_tuple_subtypes(TupleSet),
+      lists:flatten([t_opaque_tuple_tags(T) || T <- Tuples]);
+    ?union([_,_,_,_,_,_,Tuples,_,_,_]) -> t_opaque_tuple_tags(Tuples);
+    _ -> []
+  end.
+
+%% Decompose opaque instances of type arg2 to structured types, in arg1
+-spec t_struct_from_opaque(erl_type(), erl_type()) -> erl_type().
+
+t_struct_from_opaque(?function(Domain, Range), Opaque) ->
+  ?function(t_struct_from_opaque(Domain, Opaque),  
+	    t_struct_from_opaque(Range, Opaque));
+t_struct_from_opaque(?list(Types, Term, Size), Opaque) -> 
+  ?list(t_struct_from_opaque(Types, Opaque), Term, Size);
+t_struct_from_opaque(?opaque(_) = T, Opaque) -> 
+  case T =:= Opaque of
+    true  -> t_opaque_structure(T);
+    false -> T
+  end;
+t_struct_from_opaque(?product(Types), Opaque) -> 
+  ?product(list_struct_from_opaque(Types, Opaque));
+t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaque) -> T;
+t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaque)  ->
+  ?tuple(list_struct_from_opaque(Types, Opaque), Arity, Tag);
+t_struct_from_opaque(?tuple_set(Set), Opaque) ->
+  NewSet = [{Sz, [t_struct_from_opaque(T, Opaque) || T <- Tuples]}
+	    || {Sz, Tuples} <- Set],
+  ?tuple_set(NewSet);
+t_struct_from_opaque(?union(List), Opaque) ->
+  t_sup(list_struct_from_opaque(List, Opaque));
+t_struct_from_opaque(Type, _Opaque) -> Type.
+
+list_struct_from_opaque(Types, Opaque) ->
+  [t_struct_from_opaque(Type, Opaque) || Type <- Types].
+
+-spec module_builtin_opaques(module()) -> [erl_type()].
+
+module_builtin_opaques(Module) ->
+  [O || O <- all_opaque_builtins(), t_opaque_module(O) =:= Module].
+           
+%%-----------------------------------------------------------------------------
+%% Remote types
+%% These types are used for preprocessing they should never reach the analysis stage
+
+-spec t_remote(module(), atom(), [_]) -> erl_type().
+
+t_remote(Mod, Name, Args) ->
+  ?remote(set_singleton(#remote{mod=Mod, name=Name, args=Args})).
+
+-spec t_is_remote(erl_type()) -> boolean().
+
+t_is_remote(?remote(_)) -> true;
+t_is_remote(_) -> false.
+
+-spec t_solve_remote(erl_type(), dict()) -> erl_type().
+
+t_solve_remote(Type , Records) ->
+  t_solve_remote(Type, Records, ordsets:new()).
+
+t_solve_remote(?function(Domain, Range), R, C) ->
+  ?function(t_solve_remote(Domain, R, C), t_solve_remote(Range, R, C));
+t_solve_remote(?list(Types, Term, Size), R, C) ->
+  ?list(t_solve_remote(Types, R, C), Term, Size); 
+t_solve_remote(?product(Types), R, C) ->
+  ?product(list_solve_remote(Types, R, C));
+t_solve_remote(?opaque(Set), R, C) ->
+  List = ordsets:to_list(Set),
+  NewList = [Remote#opaque{struct = t_solve_remote(Struct, R, C)}
+	     || Remote = #opaque{struct = Struct} <- List],
+  ?opaque(ordsets:from_list(NewList));
+t_solve_remote(?tuple(?any, _, _) = T, _R, _C) -> T;
+t_solve_remote(?tuple(Types, Arity, Tag), R, C)  ->
+  ?tuple(list_solve_remote(Types, R, C), Arity, Tag);
+t_solve_remote(?tuple_set(Set), R, C)     ->
+  NewSet = [{Sz, [t_solve_remote(T, R, C) || T <- Tuples]} || {Sz, Tuples} <- Set],
+  ?tuple_set(NewSet);
+t_solve_remote(?remote(Set), R, C) ->
+  Cycle = ordsets:intersection(Set, C),
+  case ordsets:size(Cycle) of
+    0 -> ok;
+    _ -> 
+      CycleMsg = "Cycle detected while processing remote types: " ++
+	t_to_string(?remote(C), dict:new()),
+      throw({error, CycleMsg})
+  end,
+  NewCycle = ordsets:union(C, Set),
+  TypeFun = 
+    fun(#remote{mod = RemoteModule, name = Name, args = Args}) ->
+	case dict:find(RemoteModule, R) of
+	  error ->
+	    Msg = io_lib:format("Cannot locate module ~w to "
+				"resolve the remote type: ~w:~w()~n", 
+				[RemoteModule, RemoteModule, Name]),
+	    throw({error, Msg});
+	  {ok, RemoteDict} ->
+	    case lookup_type(Name, RemoteDict) of
+	      {type, {_TypeMod, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+		List = lists:zip(ArgNames, Args),
+		TmpVardict = dict:from_list(List),
+		NewType = t_from_form(Type, RemoteDict, TmpVardict),
+		t_solve_remote(NewType, R, NewCycle);
+	      {opaque, {OpModule, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+		List = lists:zip(ArgNames, Args),
+		TmpVardict = dict:from_list(List),
+		Rep = t_from_form(Type, RemoteDict, TmpVardict),
+		NewRep = t_solve_remote(Rep, R, NewCycle),
+		t_from_form({opaque, -1, Name, {OpModule, Args, NewRep}},
+			    RemoteDict, TmpVardict);
+	      {type, _} ->
+		Msg = io_lib:format("Unknown remote type ~w\n", [Name]),
+		throw({error, Msg});
+	      {opaque, _} ->
+		Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]),
+		throw({error, Msg});
+	      error ->
+		Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
+				    [RemoteModule, Name]),
+		throw({error, Msg}) 
+	    end
+	end
+    end,
+  RemoteList = ordsets:to_list(Set),
+  t_sup([TypeFun(RemoteType) || RemoteType <- RemoteList]);
+t_solve_remote(?union(List), R, C) -> 
+  t_sup(list_solve_remote(List, R, C));
+t_solve_remote(T, _R, _C) -> T.
+
+list_solve_remote(Types, R, C) ->
+  [t_solve_remote(Type, R, C) || 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 bool
+%%
+
+-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(?atom(?any)) -> unknown;
+t_atom_vals(?atom(Set)) -> set_to_list(Set);
+t_atom_vals(Other) ->
+  ?atom(_) = Atm = t_inf(t_atom(), Other),
+  t_atom_vals(Atm).
+
+-spec t_is_atom(erl_type()) -> boolean().
+
+t_is_atom(?atom(_)) -> true;
+t_is_atom(_) -> false.
+
+-spec t_is_atom(atom(), erl_type()) -> boolean().
+
+t_is_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false;
+t_is_atom(Atom, ?atom(Set)) when is_atom(Atom) -> set_is_singleton(Atom, Set);
+t_is_atom(Atom, _) when is_atom(Atom) -> false.
+
+%%------------------------------------
+
+-spec t_boolean() -> erl_type().
+
+t_boolean() ->
+  ?atom(set_from_list([false, true])).
+
+-spec t_is_boolean(erl_type()) -> boolean().
+
+t_is_boolean(?atom(?any)) -> false;
+t_is_boolean(?atom(Set)) ->
+  case set_size(Set) of
+    1 -> set_is_element(true, Set) orelse set_is_element(false, Set);
+    2 -> set_is_element(true, Set) andalso set_is_element(false, Set);
+    N when is_integer(N), N > 2 -> false
+  end;
+t_is_boolean(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Binaries
+%%
+
+-spec t_binary() -> erl_type().
+
+t_binary() ->
+  ?bitstr(8, 0).
+
+-spec t_is_binary(erl_type()) -> boolean().
+
+t_is_binary(?bitstr(U, B)) -> 
+  ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0);
+t_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(T1p, T2p).
+
+-spec t_bitstr_match(erl_type(), erl_type()) -> erl_type().
+
+t_bitstr_match(T1, T2) ->
+  T1p = t_inf(t_bitstr(), T1),
+  T2p = t_inf(t_bitstr(), T2),
+  bitstr_match(T1p, T2p).
+
+-spec t_is_bitstr(erl_type()) -> boolean().
+
+t_is_bitstr(?bitstr(_, _)) -> true;
+t_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(?function(?any, _)) ->
+  unknown;
+t_fun_args(?function(?product(Domain), _)) when is_list(Domain) ->
+  Domain.
+
+-spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer().
+
+t_fun_arity(?function(?any, _)) ->
+  unknown;
+t_fun_arity(?function(?product(Domain), _)) ->
+  length(Domain).
+
+-spec t_fun_range(erl_type()) -> erl_type().
+
+t_fun_range(?function(_, Range)) ->
+  Range.
+
+-spec t_is_fun(erl_type()) -> boolean().
+
+t_is_fun(?function(_, _)) -> true;
+t_is_fun(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Identifiers. Includes ports, pids and refs.
+%% 
+
+-spec t_identifier() -> erl_type().
+
+t_identifier() ->
+  ?identifier(?any).
+
+-ifdef(DO_ERL_TYPES_TEST).
+-spec t_is_identifier(erl_type()) -> erl_type().
+
+t_is_identifier(?identifier(_)) -> true;
+t_is_identifier(_) -> false.
+-endif.
+
+%%------------------------------------
+
+-spec t_port() -> erl_type().
+
+t_port() ->
+  ?identifier(set_singleton(?port_qual)).
+
+-spec t_is_port(erl_type()) -> boolean().
+
+t_is_port(?identifier(?any)) -> false;
+t_is_port(?identifier(Set)) -> set_is_singleton(?port_qual, Set);
+t_is_port(_) -> false.
+
+%%------------------------------------
+
+-spec t_pid() -> erl_type().
+
+t_pid() ->
+  ?identifier(set_singleton(?pid_qual)).
+
+-spec t_is_pid(erl_type()) -> boolean().
+
+t_is_pid(?identifier(?any)) -> false;
+t_is_pid(?identifier(Set)) -> set_is_singleton(?pid_qual, Set);
+t_is_pid(_) -> false.
+
+%%------------------------------------
+
+-spec t_reference() -> erl_type().
+
+t_reference() ->
+  ?identifier(set_singleton(?reference_qual)).
+
+-spec t_is_reference(erl_type()) -> boolean().
+
+t_is_reference(?identifier(?any)) -> false;
+t_is_reference(?identifier(Set)) -> set_is_singleton(?reference_qual, Set);
+t_is_reference(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% 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(?number(_, _)) -> true;
+t_is_number(_) -> false.
+
+%% Currently, the type system collapses all floats to ?float and does
+%% not keep any information about their values. As a result, the list
+%% that this function returns contains only integers.
+-spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...].
+
+t_number_vals(?int_set(?any)) -> unknown;
+t_number_vals(?int_set(Set)) -> set_to_list(Set);
+t_number_vals(?number(_, _)) -> unknown;
+t_number_vals(Other) ->
+  Inf = t_inf(Other, t_number()),
+  false = t_is_none(Inf), % sanity check
+  t_number_vals(Inf).
+
+%%------------------------------------
+
+-spec t_float() -> erl_type().
+
+t_float() ->
+  ?float.
+
+-spec t_is_float(erl_type()) -> boolean().
+
+t_is_float(?float) -> true;
+t_is_float(_) -> 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(?integer(_)) -> true;
+t_is_integer(_) -> false.
+
+%%------------------------------------
+
+-spec t_byte() -> erl_type().
+
+t_byte() ->
+  ?byte.
+
+-ifdef(DO_ERL_TYPES_TEST).
+-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.
+-endif.
+
+%%------------------------------------
+
+-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 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.
+
+-spec t_is_cons(erl_type()) -> boolean().
+
+t_is_cons(?nonempty_list(_, _)) -> true;
+t_is_cons(_) -> false.  
+
+-spec t_cons_hd(erl_type()) -> erl_type().
+
+t_cons_hd(?nonempty_list(Contents, _Termination)) -> Contents.
+
+-spec t_cons_tl(erl_type()) -> erl_type().
+
+t_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(?nil) -> true;
+t_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(?list(Contents, _, _)) -> Contents;
+t_list_elements(?nil) -> ?none.
+
+-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
+  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(?list(_, _, _)) -> true;
+t_is_maybe_improper_list(?nil) -> true;
+t_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
+%%   false = t_is_subtype(t_nil(), Termination),
+%%   ?list(Content, Termination, ?any).  
+
+-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).
+
+%%-----------------------------------------------------------------------------
+%% 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) ->
+  ?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([?atom(?any)|_]) -> [?any];
+get_tuple_tags([?atom(Set)|_]) ->
+  case set_size(Set) > ?TUPLE_TAG_LIMIT of
+    true -> [?any];
+    false -> [t_atom(A) || A <- set_to_list(Set)]
+  end;
+get_tuple_tags(_) -> [?any].
+
+%% to be used for a tuple with known types for its arguments (not ?any)
+-spec t_tuple_args(erl_type()) -> [erl_type()].
+
+t_tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args.
+
+%% to be used for a tuple with a known size (not ?any)
+-spec t_tuple_size(erl_type()) -> non_neg_integer().
+
+t_tuple_size(?tuple(_, Size, _)) when is_integer(Size) -> Size.
+
+-spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...].
+
+t_tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown;
+t_tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size];
+t_tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List].
+
+-spec t_tuple_subtypes(erl_type()) -> 'unknown' | [erl_type(),...].
+
+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(?tuple(_, _, _)) -> true;
+t_is_tuple(?tuple_set(_)) -> true;
+t_is_tuple(_) -> false.
+
+%%-----------------------------------------------------------------------------
+%% Non-primitive types, including some handy syntactic sugar types
+%%
+
+-spec t_constant() -> erl_type().
+
+t_constant() ->
+  t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]).
+
+-spec t_is_constant(erl_type()) -> boolean().
+
+t_is_constant(X) ->
+  t_is_subtype(X, t_constant()).
+
+-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).
+
+-spec t_iolist(non_neg_integer()) -> erl_type().
+
+t_iolist(N) when N > 0 ->
+  t_maybe_improper_list(t_sup([t_iolist(N-1), t_binary(), t_byte()]),
+		        t_sup(t_binary(), t_nil()));
+t_iolist(0) ->
+  t_maybe_improper_list(t_any(), t_sup(t_binary(), t_nil())).
+
+-spec t_timeout() -> erl_type().
+
+t_timeout() ->
+  t_sup(t_non_neg_integer(), t_atom('infinity')).
+
+%%-----------------------------------------------------------------------------
+%% Some built-in opaque types
+%%
+
+-spec t_array() -> erl_type().
+
+t_array() ->
+  t_opaque(array, array, [],
+	   t_tuple([t_atom('array'),
+		    t_non_neg_integer(), t_non_neg_integer(),
+		    t_any(), t_any()])).
+
+-spec t_dict() -> erl_type().
+
+t_dict() ->
+  t_opaque(dict, dict, [],
+	   t_tuple([t_atom('dict'),
+		    t_non_neg_integer(), t_non_neg_integer(),
+		    t_non_neg_integer(), t_non_neg_integer(),
+		    t_non_neg_integer(), t_non_neg_integer(),
+		    t_tuple(), t_tuple()])).
+
+-spec t_digraph() -> erl_type().
+
+t_digraph() ->
+  t_opaque(digraph, digraph, [],
+	   t_tuple([t_atom('digraph'),
+		    t_sup(t_atom(), t_tid()),
+		    t_sup(t_atom(), t_tid()),
+		    t_sup(t_atom(), t_tid()),
+		    t_boolean()])).
+
+-spec t_gb_set() -> erl_type().
+
+t_gb_set() ->
+  t_opaque(gb_sets, gb_set, [],
+	   t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])).
+
+-spec t_gb_tree() -> erl_type().
+
+t_gb_tree() ->
+  t_opaque(gb_trees, gb_tree, [],
+	   t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])).
+
+-spec t_queue() -> erl_type().
+
+t_queue() ->
+  t_opaque(queue, queue, [], t_tuple([t_list(), t_list()])).
+
+-spec t_set() -> erl_type().
+
+t_set() ->
+  t_opaque(sets, set, [],
+	   t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(),
+		    t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(),
+		    t_non_neg_integer(), t_tuple(), t_tuple()])).
+
+-spec t_tid() -> erl_type().
+
+t_tid() ->
+  t_opaque(ets, tid, [], t_integer()).
+
+-spec all_opaque_builtins() -> [erl_type()].
+
+all_opaque_builtins() ->
+  [t_array(), t_dict(), t_digraph(), t_gb_set(),
+   t_gb_tree(), t_queue(), t_set(), t_tid()].
+
+-spec is_opaque_builtin(atom(), atom()) -> boolean().
+
+is_opaque_builtin(array, array) -> true;
+is_opaque_builtin(dict, dict) -> true;
+is_opaque_builtin(digraph, digraph) -> true;
+is_opaque_builtin(gb_sets, gb_set) -> true;
+is_opaque_builtin(gb_trees, gb_tree) -> true;
+is_opaque_builtin(queue, queue) -> true;
+is_opaque_builtin(sets, set) -> true;
+is_opaque_builtin(ets, tid) -> true;
+is_opaque_builtin(_, _) -> false.
+
+%%------------------------------------
+
+%% ?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(?union(_) = U) ->
+%% exit(lists:flatten(io_lib:format("Union happens in t_has_var/1 ~p\n",[U])));
+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) ->
+  t_collect_vars(T, []).
+
+-spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()].
+
+t_collect_vars(?var(_) = Var, Acc) ->
+  ordsets:add_element(Var, Acc);
+t_collect_vars(?function(Domain, Range), Acc) ->
+  ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, []));
+t_collect_vars(?list(Contents, Termination, _), Acc) ->
+  ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, []));
+t_collect_vars(?product(Types), Acc) ->
+  lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types);
+t_collect_vars(?tuple(?any, ?any, ?any), Acc) ->
+  Acc;
+t_collect_vars(?tuple(Types, _, _), Acc) ->
+  lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types);
+t_collect_vars(?tuple_set(_) = TS, Acc) ->
+  lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, 
+	      t_tuple_subtypes(TS));
+t_collect_vars(_, 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_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(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(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(?int_range(From, _)) -> From;
+number_min(?int_set(Set)) -> set_min(Set);
+number_min(?number(?any, _Tag)) -> neg_inf.
+
+-spec number_max(erl_type()) -> rng_elem().
+
+number_max(?int_range(_, To)) -> To;
+number_max(?int_set(Set)) -> set_max(Set);
+number_max(?number(?any, _Tag)) -> pos_inf.
+
+%% -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([?any|_]) ->
+  ?any;
+t_sup([H1, H2|T]) ->
+  t_sup([t_sup(H1, H2)|T]);
+t_sup([H]) ->
+  subst_all_vars_to_any(H);
+t_sup([]) ->
+  ?none.
+
+-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)) ->
+  ?opaque(set_union_no_limit(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(?remote(Set1), ?remote(Set2)) ->
+  ?remote(set_union_no_limit(Set1, Set2));
+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(T1, T2) ->
+  ?union(U1) = force_union(T1),
+  ?union(U2) = force_union(T2),
+  sup_union(U1, U2).
+
+-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 = ?remote(_)) ->        ?remote_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) -> [T]; 
+    ?float -> [T];
+    ?integer(?any) -> [T];
+    ?int_range(_, _) -> [T];
+    ?int_set(Set) ->
+      [t_integer(I) || I <- Set]
+  end;
+t_elements(?opaque(_) = 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(List)) ->
+  lists:append([t_elements(T) || T <- List]);
+t_elements(?var(_)) -> [?any].  %% yes, vars exist -- what else to do here?
+%% t_elements(T) ->
+%%   io:format("T_ELEMENTS => ~p\n", [T]).
+
+%%-----------------------------------------------------------------------------
+%% 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, structured).
+
+-type t_inf_mode() :: 'opaque' | 'structured'.
+-spec t_inf(erl_type(), erl_type(), t_inf_mode()) -> erl_type().
+
+t_inf(?var(_), ?var(_), _Mode) -> ?any;
+t_inf(?var(_), T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(T, ?var(_), _Mode) -> subst_all_vars_to_any(T);
+t_inf(?any, T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(T, ?any, _Mode) -> subst_all_vars_to_any(T);
+t_inf(?unit, _, _Mode) -> ?unit;
+t_inf(_, ?unit, _Mode) -> ?unit;
+t_inf(?none, _, _Mode) -> ?none;
+t_inf(_, ?none, _Mode) -> ?none;
+t_inf(T, T, _Mode) -> subst_all_vars_to_any(T);
+t_inf(?atom(Set1), ?atom(Set2), _) ->
+  case set_intersection(Set1, Set2) of
+    ?none ->  ?none;
+    NewSet -> ?atom(NewSet)
+  end;
+t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Mode) ->
+  if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2);
+     true -> ?none
+  end;
+t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Mode) ->
+  if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1);
+     true -> ?none
+  end;
+t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Mode) ->
+  t_bitstr(U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) when U2 > U1 ->
+  inf_bitstr(U2, B2, U1, B1);
+t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) ->
+  inf_bitstr(U1, B1, U2, B2);
+t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Mode) ->
+  case t_inf(Domain1, Domain2, Mode) of
+    ?none -> ?none;
+    Domain -> ?function(Domain, t_inf(Range1, Range2, Mode))
+  end;
+t_inf(?identifier(Set1), ?identifier(Set2), _Mode) ->
+  case set_intersection(Set1, Set2) of
+    ?none -> ?none;
+    Set -> ?identifier(Set)
+  end;
+t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Mode) ->
+  ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2));
+t_inf(?nil, ?nil, _Mode) -> ?nil;
+t_inf(?nil, ?nonempty_list(_, _), _Mode) ->
+  ?none;
+t_inf(?nonempty_list(_, _), ?nil, _Mode) ->
+  ?none;
+t_inf(?nil, ?list(_Contents, Termination, _), Mode) ->
+  t_inf(?nil, Termination, Mode);
+t_inf(?list(_Contents, Termination, _), ?nil, Mode) ->
+  t_inf(?nil, Termination, Mode);
+t_inf(?list(Contents1, Termination1, Size1),
+      ?list(Contents2, Termination2, Size2), Mode) ->  
+  case t_inf(Termination1, Termination2, Mode) of
+    ?none -> ?none;
+    Termination ->
+      case t_inf(Contents1, Contents2, Mode) 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, _Mode) ->
+  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), Mode) ->
+  L1 = length(Types1),
+  L2 = length(Types2),
+  if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Mode));
+     true -> ?none
+  end;
+t_inf(?product(_), _, _Mode) ->
+  ?none;
+t_inf(_, ?product(_), _Mode) ->
+  ?none;
+t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Mode) -> T;
+t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Mode) -> T;
+t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Mode) -> T;
+t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Mode) -> T;
+t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Mode) ->
+  case t_inf_lists_strict(Elements1, Elements2, Mode) of
+    bottom -> ?none;
+    NewElements -> t_tuple(NewElements)
+  end;
+t_inf(?tuple_set(List1), ?tuple_set(List2), Mode) ->
+  inf_tuple_sets(List1, List2, Mode);
+t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Mode) ->
+  inf_tuple_sets(List, [{Arity, [T]}], Mode);
+t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Mode) ->
+  inf_tuple_sets(List, [{Arity, [T]}], Mode);
+%% be careful: here and in the next clause T can be ?opaque
+t_inf(?union(U1), T, Mode) ->
+  ?union(U2) = force_union(T),
+  inf_union(U1, U2, Mode);
+t_inf(T, ?union(U2), Mode) ->
+  ?union(U1) = force_union(T),
+  inf_union(U1, U2, Mode);
+%% and as a result, the cases for ?opaque should appear *after* ?union
+t_inf(?opaque(Set1), ?opaque(Set2), _Mode) ->
+  case set_intersection(Set1, Set2) of
+    ?none -> ?none;
+    NewSet -> ?opaque(NewSet)
+  end;
+t_inf(?opaque(_) = T1, T2, opaque) ->
+  case t_inf(t_opaque_structure(T1), T2, structured) of
+    ?none -> ?none;
+    _Type -> T1
+  end;
+t_inf(T1, ?opaque(_) = T2, opaque) ->
+  case t_inf(T1, t_opaque_structure(T2), structured) of
+    ?none -> ?none;
+    _Type -> T2
+  end;
+t_inf(#c{}, #c{}, _) ->
+  ?none.
+
+-spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()].
+
+t_inf_lists(L1, L2) ->
+  t_inf_lists(L1, L2, structured).
+
+-spec t_inf_lists([erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()].
+
+t_inf_lists(L1, L2, Mode) ->
+  t_inf_lists(L1, L2, [], Mode).
+
+-spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()].
+
+t_inf_lists([T1|Left1], [T2|Left2], Acc, Mode) ->
+  t_inf_lists(Left1, Left2, [t_inf(T1, T2, Mode)|Acc], Mode);
+t_inf_lists([], [], Acc, _Mode) ->
+  lists:reverse(Acc).
+
+%% Infimum of lists with strictness.
+%% If any element is the ?none type, the value 'bottom' is returned.
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict(L1, L2, Mode) ->
+  t_inf_lists_strict(L1, L2, [], Mode).
+
+-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()].
+
+t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Mode) ->
+  case t_inf(T1, T2, Mode) of
+    ?none -> bottom;
+    T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Mode)
+  end;
+t_inf_lists_strict([], [], Acc, _Mode) ->
+  lists:reverse(Acc).
+
+inf_tuple_sets(L1, L2, Mode) ->
+  case inf_tuple_sets(L1, L2, [], Mode) of
+    [] -> ?none;
+    [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple;
+    List -> ?tuple_set(List)
+  end.
+
+inf_tuple_sets([{Arity, Tuples1}|Left1], [{Arity, Tuples2}|Left2], Acc, Mode) ->
+  case inf_tuples_in_sets(Tuples1, Tuples2, Mode) of
+    [] -> inf_tuple_sets(Left1, Left2, Acc, Mode);
+    NewTuples -> inf_tuple_sets(Left1, Left2, [{Arity, NewTuples}|Acc], Mode)
+  end;
+inf_tuple_sets(L1 = [{Arity1, _}|Left1], L2 = [{Arity2, _}|Left2], Acc, Mode) ->
+  if Arity1 < Arity2 -> inf_tuple_sets(Left1, L2, Acc, Mode);
+     Arity1 > Arity2 -> inf_tuple_sets(L1, Left2, Acc, Mode)
+  end;
+inf_tuple_sets([], _, Acc, _Mode) -> lists:reverse(Acc);
+inf_tuple_sets(_, [], Acc, _Mode) -> lists:reverse(Acc).
+      
+inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Mode) ->
+  NewList = [t_inf_lists_strict(Elements1, Elements2, Mode)
+	     || ?tuple(Elements2, _, _) <- L2],
+  [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Mode) ->
+  NewList = [t_inf_lists_strict(Elements1, Elements2, Mode)
+	     || ?tuple(Elements1, _, _) <- L1],
+  [t_tuple(Es) || Es <- NewList, Es =/= bottom];
+inf_tuples_in_sets(L1, L2, Mode) ->
+  inf_tuples_in_sets(L1, L2, [], Mode).
+
+inf_tuples_in_sets([?tuple(Elements1, Arity, Tag)|Left1], 
+		   [?tuple(Elements2, Arity, Tag)|Left2], Acc, Mode) ->
+  case t_inf_lists_strict(Elements1, Elements2, Mode) of
+    bottom -> inf_tuples_in_sets(Left1, Left2, Acc, Mode);
+    NewElements -> 
+      inf_tuples_in_sets(Left1, Left2, [?tuple(NewElements, Arity, Tag)|Acc], Mode)
+  end;
+inf_tuples_in_sets([?tuple(_, _, Tag1)|Left1] = L1, 
+		   [?tuple(_, _, Tag2)|Left2] = L2, Acc, Mode) ->
+  if Tag1 < Tag2 -> inf_tuples_in_sets(Left1, L2, Acc, Mode);
+     Tag1 > Tag2 -> inf_tuples_in_sets(L1, Left2, Acc, Mode)
+  end;
+inf_tuples_in_sets([], _, Acc, _Mode) -> lists:reverse(Acc);
+inf_tuples_in_sets(_, [], Acc, _Mode) -> lists:reverse(Acc).
+
+inf_union(U1, U2, opaque) ->
+%%---------------------------------------------------------------------
+%%                          Under Testing
+%%----------------------------------------------------------------------
+%%   OpaqueFun = 
+%%     fun(Union1, Union2) ->
+%% 	[_,_,_,_,_,_,_,_,Opaque,_] = Union1,
+%% 	[A,B,F,I,L,N,T,M,_,_R] = Union2,
+%% 	List = [A,B,F,I,L,N,T,M],
+%%         case [T || T <- List, t_inf(T, Opaque, opaque) =/= ?none] of
+%% 	  [] -> ?none;
+%% 	  _  -> Opaque
+%% 	end
+%%     end,
+%%   O1 = OpaqueFun(U1, U2),
+%%   O2 = OpaqueFun(U2, U1),
+%%   Union = inf_union(U1, U2, 0, [], opaque),
+%%   t_sup([O1, O2, Union]);
+  inf_union(U1, U2, 0, [], opaque);
+inf_union(U1, U2, OtherMode) ->
+  inf_union(U1, U2, 0, [], OtherMode).
+
+inf_union([?none|Left1], [?none|Left2], N, Acc, Mode) ->
+  inf_union(Left1, Left2, N, [?none|Acc], Mode);
+inf_union([T1|Left1], [T2|Left2], N, Acc, Mode) ->
+  case t_inf(T1, T2, Mode) of
+    ?none -> inf_union(Left1, Left2, N, [?none|Acc], Mode);
+    T     -> inf_union(Left1, Left2, N+1, [T|Acc], Mode)
+  end;
+inf_union([], [], N, Acc, _Mode) ->
+  if N =:= 0 -> ?none;
+     N =:= 1 ->
+      [Type] = [T || T <- Acc, T =/= ?none],
+      Type;
+     N >= 2  -> ?union(lists:reverse(Acc))
+  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
+%%
+
+-spec t_subst(erl_type(), dict()) -> erl_type().
+
+t_subst(T, Dict) ->
+  case t_has_var(T) of
+    true -> t_subst(T, Dict, fun(X) -> X end);
+    false -> T
+  end.
+
+-spec subst_all_vars_to_any(erl_type()) -> erl_type().
+
+subst_all_vars_to_any(T) ->
+  case t_has_var(T) of
+    true -> t_subst(T, dict:new(), fun(_) -> ?any end);
+    false -> T
+  end.
+
+t_subst(?var(Id) = V, Dict, Fun) ->
+  case dict:find(Id, Dict) of
+    error -> Fun(V);
+    {ok, Type} -> Type
+  end;
+t_subst(?list(Contents, Termination, Size), Dict, Fun) ->
+  case t_subst(Contents, Dict, Fun) of
+    ?none -> ?none;
+    NewContents ->
+      %% Be careful here to make the termination collapse if necessary.
+      case t_subst(Termination, Dict, Fun) of
+	?nil -> ?list(NewContents, ?nil, Size);
+	?any -> ?list(NewContents, ?any, Size);
+	Other ->
+	  ?list(NewContents, NewTermination, _) = t_cons(NewContents, Other),
+	  ?list(NewContents, NewTermination, Size)
+      end
+  end;
+t_subst(?function(Domain, Range), Dict, Fun) ->
+  ?function(t_subst(Domain, Dict, Fun), t_subst(Range, Dict, Fun));
+t_subst(?product(Types), Dict, Fun) -> 
+  ?product([t_subst(T, Dict, Fun) || T <- Types]);
+t_subst(?tuple(?any, ?any, ?any) = T, _Dict, _Fun) ->
+  T;
+t_subst(?tuple(Elements, _Arity, _Tag), Dict, Fun) ->
+  t_tuple([t_subst(E, Dict, Fun) || E <- Elements]);
+t_subst(?tuple_set(_) = TS, Dict, Fun) ->
+  t_sup([t_subst(T, Dict, Fun) || T <- t_tuple_subtypes(TS)]);
+t_subst(T, _Dict, _Fun) -> 
+  T.
+	      
+%%-----------------------------------------------------------------------------
+%% Unification
+%%
+
+-spec t_unify(erl_type(), erl_type()) -> {erl_type(), [{_, erl_type()}]}.
+
+t_unify(T1, T2) ->
+  {T, Dict} = t_unify(T1, T2, dict:new()),
+  {t_subst(T, Dict), lists:keysort(1, dict:to_list(Dict))}.
+
+t_unify(?var(Id) = T, ?var(Id), Dict) ->
+  {T, Dict};
+t_unify(?var(Id1) = T, ?var(Id2), Dict) ->
+  case dict:find(Id1, Dict) of
+    error -> 
+      case dict:find(Id2, Dict) of
+	error -> {T, dict:store(Id2, T, Dict)};
+	{ok, Type} -> {Type, t_unify(T, Type, Dict)}
+      end;
+    {ok, Type1} ->
+      case dict:find(Id2, Dict) of
+	error -> {Type1, dict:store(Id2, T, Dict)};
+	{ok, Type2} -> t_unify(Type1, Type2, Dict)
+      end
+  end;
+t_unify(?var(Id), Type, Dict) ->
+  case dict:find(Id, Dict) of
+    error -> {Type, dict:store(Id, Type, Dict)};
+    {ok, VarType} -> t_unify(VarType, Type, Dict)
+  end;
+t_unify(Type, ?var(Id), Dict) ->
+  case dict:find(Id, Dict) of
+    error -> {Type, dict:store(Id, Type, Dict)};
+    {ok, VarType} -> t_unify(VarType, Type, Dict)
+  end;
+t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) ->
+  {Domain, Dict1} = t_unify(Domain1, Domain2, Dict),
+  {Range, Dict2} = t_unify(Range1, Range2, Dict1),
+  {?function(Domain, Range), Dict2};
+t_unify(?list(Contents1, Termination1, Size), 
+	?list(Contents2, Termination2, Size), Dict) ->
+  {Contents, Dict1} = t_unify(Contents1, Contents2, Dict),
+  {Termination, Dict2} = t_unify(Termination1, Termination2, Dict1),
+  {?list(Contents, Termination, Size), Dict2};
+t_unify(?product(Types1), ?product(Types2), Dict) -> 
+  {Types, Dict1} = unify_lists(Types1, Types2, Dict),
+  {?product(Types), Dict1};
+t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), Dict) ->
+  {T, Dict};
+t_unify(?tuple(Elements1, Arity, _), 
+	?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any ->
+  {NewElements, Dict1} = unify_lists(Elements1, Elements2, Dict),
+  {t_tuple(NewElements), Dict1};
+t_unify(?tuple_set([{Arity, _}]) = T1, 
+	?tuple(_, Arity, _) = T2, Dict) when Arity =/= ?any ->
+  unify_tuple_set_and_tuple(T1, T2, Dict);
+t_unify(?tuple(_, Arity, _) = T1,
+	?tuple_set([{Arity, _}]) = T2, Dict) when Arity =/= ?any ->
+  unify_tuple_set_and_tuple(T2, T1, Dict);
+t_unify(?tuple_set(List1), ?tuple_set(List2), Dict) ->
+  {Tuples, NewDict} = 
+    unify_lists(lists:append([T || {_Arity, T} <- List1]), 
+		lists:append([T || {_Arity, T} <- List2]), Dict),
+  {t_sup(Tuples), NewDict};
+t_unify(T, T, Dict) ->
+  {T, Dict};
+t_unify(T1, T2, _) ->
+  throw({mismatch, T1, T2}).
+
+unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]), 
+			  ?tuple(Elements2, Arity, _), Dict) ->
+  %% Can only work if the single tuple has variables at correct places.
+  %% Collapse the tuple set.
+  {NewElements, Dict1} = unify_lists(sup_tuple_elements(List), Elements2, Dict),
+  {t_tuple(NewElements), Dict1}.
+
+unify_lists(L1, L2, Dict) ->
+  unify_lists(L1, L2, Dict, []).
+
+unify_lists([T1|Left1], [T2|Left2], Dict, Acc) ->
+  {NewT, NewDict} = t_unify(T1, T2, Dict),
+  unify_lists(Left1, Left2, NewDict, [NewT|Acc]);
+unify_lists([], [], Dict, Acc) ->
+  {lists:reverse(Acc), Dict}.
+
+%%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(?any, _) -> ?any;
+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(Set1), ?opaque(Set2)) ->
+  case set_subtract(Set1, Set2) of
+    ?none -> ?none;
+    Set -> ?opaque(Set)
+  end;
+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} -> Termination1;
+	    {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(?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 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) ->
+  subtract_union(U1, U2, 0, []).
+
+-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),
+  t_is_equal(T1, Inf).
+
+-spec t_is_instance(erl_type(), erl_type()) -> boolean().
+
+t_is_instance(ConcreteType, Type) ->
+  t_is_subtype(ConcreteType, t_unopaque(Type)).
+
+-spec t_unopaque(erl_type()) -> erl_type().
+
+t_unopaque(T) ->
+  t_unopaque(T, 'universe').
+
+-spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type().
+
+t_unopaque(?opaque(_) = T, Opaques) ->
+  case Opaques =:= universe orelse lists:member(T, Opaques) of
+    true -> t_unopaque(t_opaque_structure(T), Opaques);
+    false -> T  % XXX: needs revision for parametric opaque data types
+  end;
+t_unopaque(?list(ElemT, Termination, Sz), Opaques) ->
+  ?list(t_unopaque(ElemT, Opaques), Termination, Sz);
+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(?union([A,B,F,I,L,N,T,M,O,R]), Opaques) ->
+  UL = t_unopaque(L, Opaques),
+  UT = t_unopaque(T, Opaques),
+  UO = case O of
+	 ?none -> [];
+	 ?opaque(Os) -> [t_unopaque(S, Opaques) || #opaque{struct = S} <- Os]
+       end,
+  t_sup([?union([A,B,F,I,UL,N,UT,M,?none,R])|UO]);
+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(T, _K) -> T.
+
+%%============================================================================
+%% 
+%% Abstract records. Used for comparing contracts.
+%%
+%%============================================================================
+
+-spec t_abstract_records(erl_type(), dict()) -> 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(NewContents, NewTermination, _) = t_cons(NewContents, Other),
+	  ?list(NewContents, 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] = t_atom_vals(Tag),
+  case lookup_record(TagAtom, Arity - 1, RecDict) of
+    error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
+    {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]])
+  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(T, _RecDict) -> 
+  T.
+
+%% Map over types. Depth first. Used by the contract checker. ?list is
+%% not fully implemented so take care when changing the type in Termination.
+
+-spec t_map(fun((erl_type()) -> erl_type()), erl_type()) -> erl_type().
+
+t_map(Fun, ?list(Contents, Termination, Size)) ->
+  Fun(?list(t_map(Fun, Contents), t_map(Fun, Termination), Size));
+t_map(Fun, ?function(Domain, Range)) ->
+  Fun(?function(t_map(Fun, Domain), t_map(Fun, Range)));
+t_map(Fun, ?product(Types)) -> 
+  Fun(?product([t_map(Fun, T) || T <- Types]));
+t_map(Fun, ?union(Types)) ->
+  Fun(t_sup([t_map(Fun, T) || T <- Types]));
+t_map(Fun, ?tuple(?any, ?any, ?any) = T) ->
+  Fun(T);
+t_map(Fun, ?tuple(Elements, _Arity, _Tag)) ->
+  Fun(t_tuple([t_map(Fun, E) || E <- Elements]));
+t_map(Fun, ?tuple_set(_) = Tuples) ->
+  Fun(t_sup([t_map(Fun, T) || T <- t_tuple_subtypes(Tuples)]));
+t_map(Fun, T) ->
+  Fun(T).
+
+%%=============================================================================
+%%
+%% Prettyprinter
+%%
+%%=============================================================================
+
+-spec t_to_string(erl_type()) -> string().
+
+t_to_string(T) ->
+  t_to_string(T, dict:new()).
+
+-spec t_to_string(erl_type(), dict()) -> 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(8, 0), _RecDict) ->
+  "binary()";
+t_to_string(?bitstr(0, 0), _RecDict) ->
+  "<<>>";
+t_to_string(?bitstr(0, B), _RecDict) ->
+  io_lib:format("<<_:~w>>", [B]);
+t_to_string(?bitstr(U, 0), _RecDict) ->
+  io_lib:format("<<_:_*~w>>", [U]);
+t_to_string(?bitstr(U, B), _RecDict) ->
+  io_lib: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) ->
+  if Set =:= ?any -> "identifier()";
+     true -> sequence([io_lib:format("~w()", [T]) 
+		       || T <- set_to_list(Set)], [], " | ")
+  end;
+t_to_string(?opaque(Set), _RecDict) ->
+  sequence([case is_opaque_builtin(Mod, Name) of
+	      true  -> io_lib:format("~w()", [Name]);
+	      false -> io_lib:format("~w:~w()", [Mod, Name])
+	    end
+	    || #opaque{mod = Mod, name = Name} <- set_to_list(Set)], [], " | ");
+t_to_string(?matchstate(Pres, Slots), RecDict) ->
+  io_lib:format("ms(~s,~s)", [t_to_string(Pres, RecDict),
+			      t_to_string(Slots,RecDict)]);
+t_to_string(?nil, _RecDict) ->
+  "[]";
+t_to_string(?nonempty_list(Contents, Termination), RecDict) ->
+  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 ->
+	  erlang:error({illegal_list, ?nonempty_list(Contents, Termination)})
+      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.      
+      case Contents =:= ?any of
+	true -> ok;
+	false ->
+	  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) ->
+  lists:flatten(io_lib: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(?remote(Set), RecDict) ->
+  sequence([case Args =:= [] of
+	      true  -> io_lib:format("~w:~w()", [Mod, Name]);
+	      false ->
+		ArgString = comma_sequence(Args, RecDict),
+		io_lib:format("~w:~w(~s)", [Mod, Name, ArgString])
+	    end
+	    || #remote{mod = Mod, name = Name, args = Args} <- set_to_list(Set)],
+	   [], " | ");
+t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
+t_to_string(?tuple(Elements, _Arity, ?any), RecDict) ->   
+  "{" ++ comma_sequence(Elements, RecDict) ++ "}";
+t_to_string(?tuple(Elements, Arity, Tag), RecDict) ->
+  [TagAtom] = t_atom_vals(Tag),
+  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) ->
+  io_lib:format("~s", [atom_to_list(Id)]);
+t_to_string(?var(Id), _RecDict) when is_integer(Id) ->
+  io_lib:format("var(~w)", [Id]).
+
+record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
+  FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
+  "#" ++ atom_to_list(Tag) ++ "{" ++ sequence(FieldStrings, [], ",") ++ "}".
+
+record_fields_to_string([Field|Left1], [{FieldName, DeclaredType}|Left2], 
+			RecDict, Acc) ->
+  PrintType =
+    case t_is_equal(Field, DeclaredType) of
+      true -> false;
+      false ->
+	case t_is_any(DeclaredType) andalso t_is_atom(undefined, Field) of
+	  true -> false;
+	  false ->
+	    TmpType = t_subtract(DeclaredType, t_atom(undefined)),
+	    not t_is_equal(Field, TmpType)
+	end
+    end,
+  case PrintType of
+    false -> record_fields_to_string(Left1, Left2, RecDict, Acc);
+    true ->
+      String = atom_to_list(FieldName) ++ "::" ++ t_to_string(Field, RecDict),
+      record_fields_to_string(Left1, Left2, RecDict, [String|Acc])
+  end;
+record_fields_to_string([], [], _RecDict, Acc) ->
+  lists:reverse(Acc).
+
+comma_sequence(Types, RecDict) ->
+  List = [case T =:= ?any of
+	    true -> "_";
+	    false -> t_to_string(T, RecDict)
+	  end || T <- Types],
+  sequence(List, ",").
+
+union_sequence(Types, RecDict) ->
+  List = [t_to_string(T, RecDict) || T <- Types], 
+  sequence(List, " | ").
+
+sequence(List, Delimiter) ->
+  sequence(List, [], Delimiter).
+
+sequence([], [], _Delimiter) ->
+  [];
+sequence([T], Acc, _Delimiter) ->
+  lists:flatten(lists:reverse([T|Acc]));
+sequence([T|Left], Acc, Delimiter) -> 
+  sequence(Left, [T ++ Delimiter|Acc], Delimiter).
+
+%%=============================================================================
+%% 
+%% Build a type from parse forms.
+%%
+%%=============================================================================
+
+-spec t_from_form(parse_form()) -> erl_type().
+
+t_from_form(Form) ->
+  t_from_form(Form, dict:new()).
+
+-spec t_from_form(parse_form(), dict()) -> erl_type().
+
+t_from_form(Form, RecDict) ->
+  t_from_form(Form, RecDict, dict:new()).
+
+-spec t_from_form(parse_form(), dict(), dict()) -> erl_type().
+
+t_from_form({var, _L, '_'}, _RecDict, _VarDict) -> t_any();
+t_from_form({var, _L, Name}, _RecDict, VarDict) ->
+  case dict:find(Name, VarDict) of
+    error -> t_var(Name);
+    {ok, Val} -> Val
+  end;
+t_from_form({ann_type, _L, [_Var, Type]}, RecDict, VarDict) ->
+  t_from_form(Type, RecDict, VarDict);
+t_from_form({paren_type, _L, [Type]}, RecDict, VarDict) ->
+  t_from_form(Type, RecDict, VarDict);
+t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
+	    RecDict, VarDict) ->
+  t_remote(Module, Type, [t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({atom, _L, Atom}, _RecDict, _VarDict) -> t_atom(Atom);
+t_from_form({integer, _L, Int}, _RecDict, _VarDict) -> t_integer(Int);
+t_from_form({type, _L, any, []}, _RecDict, _VarDict) -> t_any();
+t_from_form({type, _L, arity, []}, _RecDict, _VarDict) -> t_arity();
+t_from_form({type, _L, array, []}, _RecDict, _VarDict) -> t_array();
+t_from_form({type, _L, atom, []}, _RecDict, _VarDict) -> t_atom();
+t_from_form({type, _L, binary, []}, _RecDict, _VarDict) -> t_binary();
+t_from_form({type, _L, binary, [{integer, _, Base}, {integer, _, Unit}]}, 
+	    _RecDict, _VarDict) -> 
+  t_bitstr(Unit, Base);
+t_from_form({type, _L, bitstring, []}, _RecDict, _VarDict) -> t_bitstr();
+t_from_form({type, _L, bool, []}, _RecDict, _VarDict) -> t_boolean();	% XXX: Temporarily
+t_from_form({type, _L, boolean, []}, _RecDict, _VarDict) -> t_boolean();
+t_from_form({type, _L, byte, []}, _RecDict, _VarDict) -> t_byte();
+t_from_form({type, _L, char, []}, _RecDict, _VarDict) -> t_char();
+t_from_form({type, _L, dict, []}, _RecDict, _VarDict) -> t_dict();
+t_from_form({type, _L, digraph, []}, _RecDict, _VarDict) -> t_digraph();
+t_from_form({type, _L, float, []}, _RecDict, _VarDict) -> t_float();
+t_from_form({type, _L, function, []}, _RecDict, _VarDict) -> t_fun();
+t_from_form({type, _L, 'fun', []}, _RecDict, _VarDict) -> t_fun();
+t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, RecDict, VarDict) ->
+  t_fun(t_from_form(Range, RecDict, VarDict));
+t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, 
+	    RecDict, VarDict) -> 
+  t_fun([t_from_form(D, RecDict, VarDict) || D <- Domain], 
+	t_from_form(Range, RecDict, VarDict));
+t_from_form({type, _L, gb_set, []}, _RecDict, _VarDict) -> t_gb_set();
+t_from_form({type, _L, gb_tree, []}, _RecDict, _VarDict) -> t_gb_tree();
+t_from_form({type, _L, identifier, []}, _RecDict, _VarDict) -> t_identifier();
+t_from_form({type, _L, integer, []}, _RecDict, _VarDict) -> t_integer();
+t_from_form({type, _L, iodata, []}, _RecDict, _VarDict) -> t_iodata();
+t_from_form({type, _L, iolist, []}, _RecDict, _VarDict) -> t_iolist();
+t_from_form({type, _L, list, []}, _RecDict, _VarDict) -> t_list();
+t_from_form({type, _L, list, [Type]}, RecDict, VarDict) -> 
+  t_list(t_from_form(Type, RecDict, VarDict));
+t_from_form({type, _L, mfa, []}, _RecDict, _VarDict) -> t_mfa();
+t_from_form({type, _L, module, []}, _RecDict, _VarDict) -> t_module();
+t_from_form({type, _L, nil, []}, _RecDict, _VarDict) -> t_nil();
+t_from_form({type, _L, neg_integer, []}, _RecDict, _VarDict) -> t_neg_integer();
+t_from_form({type, _L, non_neg_integer, []}, _RecDict, _VarDict) -> 
+  t_non_neg_integer();
+t_from_form({type, _L, no_return, []}, _RecDict, _VarDict) -> t_unit();
+t_from_form({type, _L, node, []}, _RecDict, _VarDict) -> t_node();
+t_from_form({type, _L, none, []}, _RecDict, _VarDict) -> t_none();
+t_from_form({type, _L, nonempty_list, []}, _RecDict, _VarDict) -> 
+  t_nonempty_list();
+t_from_form({type, _L, nonempty_list, [Type]}, RecDict, VarDict) -> 
+  t_nonempty_list(t_from_form(Type, RecDict, VarDict));
+t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, 
+	    RecDict, VarDict) -> 
+  t_cons(t_from_form(Cont, RecDict, VarDict), 
+	 t_from_form(Term, RecDict, VarDict));
+t_from_form({type, _L, nonempty_maybe_improper_list, []}, _RecDict, _VarDict) ->
+  t_cons(?any, ?any);
+t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, 
+	    RecDict, VarDict) -> 
+  t_cons(t_from_form(Cont, RecDict, VarDict), 
+	 t_from_form(Term, RecDict, VarDict));
+t_from_form({type, _L, nonempty_string, []}, _RecDict, _VarDict) -> 
+  t_nonempty_string();
+t_from_form({type, _L, number, []}, _RecDict, _VarDict) -> t_number();
+t_from_form({type, _L, pid, []}, _RecDict, _VarDict) -> t_pid();
+t_from_form({type, _L, port, []}, _RecDict, _VarDict) -> t_port();
+t_from_form({type, _L, pos_integer, []}, _RecDict, _VarDict) -> t_pos_integer();
+t_from_form({type, _L, maybe_improper_list, []}, _RecDict, _VarDict) -> 
+  t_maybe_improper_list();
+t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, 
+	    RecDict, VarDict) ->
+  t_maybe_improper_list(t_from_form(Content, RecDict, VarDict), 
+			t_from_form(Termination, RecDict, VarDict));
+t_from_form({type, _L, product, Elements}, RecDict, VarDict) ->
+  t_product([t_from_form(E, RecDict, VarDict) || E <- Elements]);
+t_from_form({type, _L, queue, []}, _RecDict, _VarDict) -> t_queue();
+t_from_form({type, _L, range, [{integer, _, From}, {integer, _, To}]}, 
+	    _RecDict, _VarDict) -> 
+  t_from_range(From, To);
+t_from_form({type, _L, record, [Name|Fields]}, RecDict, VarDict) -> 
+  record_from_form(Name, Fields, RecDict, VarDict);
+t_from_form({type, _L, reference, []}, _RecDict, _VarDict) -> t_reference();
+t_from_form({type, _L, set, []}, _RecDict, _VarDict) -> t_set();
+t_from_form({type, _L, string, []}, _RecDict, _VarDict) -> t_string();
+t_from_form({type, _L, term, []}, _RecDict, _VarDict) -> t_any();
+t_from_form({type, _L, tid, []}, _RecDict, _VarDict) -> t_tid();
+t_from_form({type, _L, timeout, []}, _RecDict, _VarDict) -> t_timeout();
+t_from_form({type, _L, tuple, any}, _RecDict, _VarDict) -> t_tuple();
+t_from_form({type, _L, tuple, Args}, RecDict, VarDict) -> 
+  t_tuple([t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({type, _L, union, Args}, RecDict, VarDict) -> 
+  t_sup([t_from_form(A, RecDict, VarDict) || A <- Args]);
+t_from_form({type, _L, Name, Args}, RecDict, VarDict) ->
+  case lookup_type(Name, RecDict) of
+    {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+      List = lists:zipwith(fun(ArgName, ArgType) -> 
+			       {ArgName, t_from_form(ArgType, RecDict, VarDict)}
+			   end, ArgNames, Args),
+      TmpVardict = dict:from_list(List),
+      t_from_form(Type, RecDict, TmpVardict);
+    {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
+      List = lists:zipwith(fun(ArgName, ArgType) -> 
+			       {ArgName, t_from_form(ArgType, RecDict, VarDict)}
+			   end, ArgNames, Args),
+      TmpVardict = dict:from_list(List),
+      Rep = t_from_form(Type, RecDict, TmpVardict),
+      t_from_form({opaque, -1, Name, {Module, Args, Rep}}, RecDict, VarDict);
+    {type, _} ->
+      throw({error, io_lib:format("Unknown type ~w\n", [Name])});
+    {opaque, _} ->
+      throw({error, io_lib:format("Unknown opaque type ~w\n", [Name])});
+    error ->
+      throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) 
+  end;
+t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _RecDict, _VarDict) -> 
+  case Args of
+    [] -> t_opaque(Mod, Name, Args, Rep);
+    _ -> throw({error, "Polymorphic opaque types not supported yet"})
+  end.
+
+record_from_form({atom, _, Name}, ModFields, RecDict, VarDict) ->
+  case lookup_record(Name, RecDict) of
+    {ok, DeclFields} ->
+      case get_mod_record(ModFields, DeclFields, RecDict, VarDict) of
+	{error, FieldName} ->
+	  throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n", 
+				      [Name, FieldName])});
+	{ok, NewFields} ->
+	  t_tuple([t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]])
+      end;
+    error ->
+      throw({error, 
+	     erlang:error(io_lib:format("Unknown record #~w{}\n", [Name]))})
+  end.
+
+get_mod_record([], DeclFields, _RecDict, _VarDict) ->
+  {ok, DeclFields};
+get_mod_record(ModFields, DeclFields, RecDict, VarDict) ->
+  DeclFieldsDict = orddict:from_list(DeclFields),
+  ModFieldsDict = build_field_dict(ModFields, RecDict, VarDict),
+  case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of
+    {error, _FieldName} = Error -> Error;
+    {ok, FinalOrdDict} ->
+      {ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)}
+	    || {FieldName, _} <- DeclFields]}
+  end.
+
+build_field_dict(FieldTypes, RecDict, VarDict) ->
+  build_field_dict(FieldTypes, RecDict, VarDict, []).
+
+build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], 
+		 RecDict, VarDict, Acc) ->
+  NewAcc = [{Name, t_from_form(Type, RecDict, VarDict)}|Acc],
+  build_field_dict(Left, RecDict, VarDict, NewAcc);
+build_field_dict([], _RecDict, _VarDict, Acc) ->
+  orddict:from_list(Acc).
+
+get_mod_record([{FieldName, DeclType}|Left1], 
+	       [{FieldName, ModType}|Left2], Acc) ->
+  case t_is_var(ModType) orelse t_is_subtype(ModType, DeclType) of
+    false -> {error, FieldName};
+    true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
+  end;
+get_mod_record([{FieldName1, _DeclType} = DT|Left1], 
+	       [{FieldName2, _ModType}|_] = List2, 
+	       Acc) when FieldName1 < FieldName2 ->
+  get_mod_record(Left1, List2, [DT|Acc]);
+get_mod_record(DeclFields, [], Acc) ->
+  {ok, orddict:from_list(Acc ++ DeclFields)};
+get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
+  {error, FieldName2}.
+
+-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({ann_type, _L, [Var, Type]}) ->
+  t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type);
+t_form_to_string({paren_type, _L, [Type]}) ->
+  io_lib:format("(~s)", [t_form_to_string(Type)]);
+t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
+  ArgString = "(" ++ sequence(t_form_to_string_list(Args), ",") ++ ")",
+  io_lib:format("~w:~w", [Mod, Name]) ++ ArgString;
+t_form_to_string({type, _L, arity, []}) -> "arity()";
+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((" ++ sequence(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, 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}) ->
+  "<" ++ sequence(t_form_to_string_list(Elements), ",") ++ ">";
+t_form_to_string({type, _L, range, [{integer, _, From}, {integer, _, To}]}) ->
+  io_lib:format("~w..~w", [From, To]);
+t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
+  io_lib:format("#~w{}", [Name]);
+t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
+  FieldString = sequence(t_form_to_string_list(Fields), ","),
+  io_lib:format("#~w{~s}", [Name, FieldString]);
+t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
+  io_lib:format("~w::~s", [Name, t_form_to_string(Type)]);
+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}) ->
+  "{" ++ sequence(t_form_to_string_list(Args), ",") ++ "}";
+t_form_to_string({type, _L, union, Args}) ->
+  sequence(t_form_to_string_list(Args), " | ");
+t_form_to_string({type, _L, Name, []} = T) ->
+  try t_to_string(t_from_form(T))
+  catch throw:{error, _} -> atom_to_list(Name) ++ "()"
+  end;
+t_form_to_string({type, _L, binary, [{integer, _, X}, {integer, _, Y}]}) ->
+  case Y of
+    0 ->
+      case X of
+	0 -> "<<>>";
+	_ -> io_lib:format("<<_:~w>>", [X])
+      end
+  end;
+t_form_to_string({type, _L, Name, List}) -> 
+  io_lib:format("~w(~s)", [Name, sequence(t_form_to_string_list(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).  
+  
+%%=============================================================================
+%% 
+%% 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 lookup_record(atom(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}.
+
+lookup_record(Tag, RecDict) when is_atom(Tag) ->
+  case dict:find({record, Tag}, RecDict) of
+    {ok, [{_Arity, Fields}]} -> {ok, Fields};
+    {ok, 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(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}.
+
+lookup_record(Tag, Arity, RecDict) when is_atom(Tag) ->
+  case dict:find({record, Tag}, RecDict) of
+    {ok, [{Arity, Fields}]} -> {ok, Fields};
+    {ok, OrdDict} -> orddict:find(Arity, OrdDict);
+    error -> error
+  end.
+
+lookup_type(Name, RecDict) ->
+  case dict:find({type, Name}, RecDict) of
+    error ->
+      case dict:find({opaque, Name}, RecDict) of
+	error -> error;
+	{ok, Found} -> {opaque, Found}
+      end;
+    {ok, Found} -> {type, Found}
+  end.
+
+-spec type_is_defined('type' | 'opaque', atom(), dict()) -> boolean().
+
+type_is_defined(TypeOrOpaque, Name, RecDict) ->
+  dict:is_key({TypeOrOpaque, Name}, RecDict).
+
+%% -----------------------------------
+%% 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.
+
+set_union_no_limit(?any, _) -> ?any;
+set_union_no_limit(_, ?any) -> ?any;
+set_union_no_limit(S1, S2)  -> ordsets:union(S1, S2).
+
+%% 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 -> io_lib:format("~w", [X])
+       end || X <- set_to_list(Set)],
+  sequence(L, [], " | ").
+
+set_min([H|_]) -> H.
+
+set_max(Set) ->
+  hd(lists:reverse(Set)).
+
+%%=============================================================================
+%% 
+%% 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.
+  
+%%=============================================================================
+%% Consistency-testing function(s) below
+%%=============================================================================
+
+-ifdef(DO_ERL_TYPES_TEST).		  
+
+test() ->
+  Atom1  = t_atom(),
+  Atom2  = t_atom(foo),
+  Atom3  = t_atom(bar),
+  true   = t_is_atom(Atom2),
+
+  True   = t_atom(true),
+  False  = t_atom(false),
+  Bool   = t_boolean(),
+  true   = t_is_boolean(True),
+  true   = t_is_boolean(Bool),
+  false  = t_is_boolean(Atom1),
+
+  Binary = t_binary(),
+  true   = t_is_binary(Binary),
+
+  Bitstr = t_bitstr(),
+  true   = t_is_bitstr(Bitstr),
+  
+  Bitstr1 = t_bitstr(7, 3),
+  true   = t_is_bitstr(Bitstr1),
+  false  = t_is_binary(Bitstr1),
+
+  Bitstr2 = t_bitstr(16, 8),
+  true   = t_is_bitstr(Bitstr2),
+  true   = t_is_binary(Bitstr2),
+  
+  ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
+  ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
+
+  Int1   = t_integer(),
+  Int2   = t_integer(1),
+  Int3   = t_integer(16#ffffffff),
+  true   = t_is_integer(Int2),
+  true   = t_is_byte(Int2),
+  false  = t_is_byte(Int3),
+  false  = t_is_byte(t_from_range(-1, 1)),
+  true   = t_is_byte(t_from_range(1, ?MAX_BYTE)),
+  
+  Tuple1 = t_tuple(),
+  Tuple2 = t_tuple(3),
+  Tuple3 = t_tuple([Atom1, Int1]),
+  Tuple4 = t_tuple([Tuple1, Tuple2]),
+  Tuple5 = t_tuple([Tuple3, Tuple4]),
+  Tuple6 = t_limit(Tuple5, 2),
+  Tuple7 = t_limit(Tuple5, 3),
+  true   = t_is_tuple(Tuple1),  
+  
+  Port   = t_port(),
+  Pid    = t_pid(),
+  Ref    = t_reference(),
+  Identifier = t_identifier(),
+  false  = t_is_reference(Port),
+  true   = t_is_identifier(Port),
+
+  Function1 = t_fun(),
+  Function2 = t_fun(Pid),
+  Function3 = t_fun([], Pid),
+  Function4 = t_fun([Port, Pid], Pid),
+  Function5 = t_fun([Pid, Atom1], Int2),
+  true      = t_is_fun(Function3),  
+
+  List1 = t_list(),
+  List2 = t_list(t_boolean()),
+  List3 = t_cons(t_boolean(), List2),
+  List4 = t_cons(t_boolean(), t_atom()),
+  List5 = t_cons(t_boolean(), t_nil()),
+  List6 = t_cons_tl(List5),
+  List7 = t_sup(List4, List5),
+  List8 = t_inf(List7, t_list()),
+  List9 = t_cons(),
+  List10 = t_cons_tl(List9),
+  true  = t_is_boolean(t_cons_hd(List5)),
+  true  = t_is_list(List5),
+  false = t_is_list(List4),
+
+  Product1 = t_product([Atom1, Atom2]),
+  Product2 = t_product([Atom3, Atom1]),
+  Product3 = t_product([Atom3, Atom2]),
+
+  Union1 = t_sup(Atom2, Atom3),
+  Union2 = t_sup(Tuple2, Tuple3),
+  Union3 = t_sup(Int2, Atom3),
+  Union4 = t_sup(Port, Pid),
+  Union5 = t_sup(Union4, Int1),
+  Union6 = t_sup(Function1, Function2),
+  Union7 = t_sup(Function4, Function5),
+  Union8 = t_sup(True, False),
+  true   = t_is_boolean(Union8),
+  Union9 = t_sup(Int2, t_integer(2)),
+  true   = t_is_byte(Union9),
+  Union10 = t_sup(t_tuple([t_atom(true), ?any]), 
+		  t_tuple([t_atom(false), ?any])),
+  
+  ?any   = t_sup(Product3, Function5),
+
+  Atom3  = t_inf(Union3, Atom1),
+  Union2 = t_inf(Union2, Tuple1),
+  Int2   = t_inf(Int1, Union3),
+  Union4 = t_inf(Union4, Identifier),
+  Port   = t_inf(Union5, Port),
+  Function4 = t_inf(Union7, Function4),
+  ?none  = t_inf(Product2, Atom1),
+  Product3 = t_inf(Product1, Product2),
+  Function5 = t_inf(Union7, Function5),
+  true   = t_is_byte(t_inf(Union9, t_number())),
+  true   = t_is_char(t_inf(Union9, t_number())),
+
+  io:format("3? ~p ~n", [?int_set([3])]),
+
+  RecDict = dict:store({foo, 2}, [bar, baz], dict:new()),
+  Record1 = t_from_term({foo, [1,2], {1,2,3}}),
+  
+  Types = [
+	   Atom1,
+	   Atom2,
+	   Atom3,
+	   Binary,
+	   Int1,
+	   Int2,
+	   Tuple1,
+	   Tuple2,
+	   Tuple3,
+	   Tuple4,
+	   Tuple5,
+	   Tuple6,
+	   Tuple7,
+	   Ref,
+	   Port,
+	   Pid,
+	   Identifier,
+	   List1,
+	   List2,
+	   List3,
+	   List4,
+	   List5,
+	   List6,
+	   List7,
+	   List8,
+	   List9,
+	   List10,
+	   Function1,
+	   Function2,
+	   Function3,
+	   Function4,
+	   Function5,
+	   Product1,
+	   Product2,
+	   Record1,
+	   Union1,
+	   Union2,
+	   Union3,
+	   Union4,
+	   Union5,
+	   Union6,
+	   Union7,
+	   Union8,
+	   Union10,
+	   t_inf(Union10, t_tuple([t_atom(true), t_integer()]))
+	  ],
+  io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]).
+       
+-endif.