Add support for the compilation of the is_map/1 guard to native code

Namely, extend the HiPE tagging scheme info, properly handle the translation
of the (is_)map type test to Icode and RTL and support handling of the map()
type in the type system.

While at it, also performed some clean up of things that needed small fixes.

4 files changed, 58 insertions, 40 deletions

diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 28281a2fac..47b8dc766a 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -126,6 +126,8 @@
 	 t_is_instance/2,
 	 t_is_integer/1, t_is_integer/2,
 	 t_is_list/1,
+	 t_is_map/1,
+	 t_is_map/2,
 	 t_is_matchstate/1,
 	 t_is_nil/1, t_is_nil/2,
 	 t_is_non_neg_integer/1,
@@ -148,6 +150,8 @@
 	 t_list/1,
 	 t_list_elements/1, t_list_elements/2,
 	 t_list_termination/1,
+	 t_map/0,
+	 t_map/1,
 	 t_matchstate/0,
 	 t_matchstate/2,
 	 t_matchstate_present/1,
@@ -208,20 +212,12 @@
 	 lift_list_to_pos_empty/1,
          is_opaque_type/2,
 	 is_erl_type/1,
-	 atom_to_string/1,
-
-	 t_is_map/2,
-	 t_map/1,
-	 t_map/0
+	 atom_to_string/1
 	]).
 
 %%-define(DO_ERL_TYPES_TEST, true).
 -compile({no_auto_import,[min/2,max/2]}).
 
-%% HiPE does not understand Maps
-%% (guard function is_map/1 in t_from_term/1)
--compile(no_native).
-
 -ifdef(DO_ERL_TYPES_TEST).
 -export([test/0]).
 -else.
@@ -1733,11 +1729,16 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) ->
 t_map() ->
   ?map([]).
 
--spec t_map([{erl_type(),erl_type()}]) -> erl_type().
+-spec t_map([{erl_type(), erl_type()}]) -> erl_type().
 
 t_map(_) ->
   ?map([]).
 
+-spec t_is_map(erl_type()) -> boolean().
+
+t_is_map(Type) ->
+  t_is_map(Type, 'universe').
+
 -spec t_is_map(erl_type(), opaques()) -> boolean().
 
 t_is_map(Type, Opaques) ->
@@ -1746,7 +1747,6 @@ t_is_map(Type, Opaques) ->
 is_map1(?map(_)) -> true;
 is_map1(_) -> false.
 
-
 %%-----------------------------------------------------------------------------
 %% Tuples
 %%
@@ -2167,10 +2167,10 @@ t_from_term(T) when is_function(T) ->
   {arity, Arity} = erlang:fun_info(T, arity),
   t_fun(Arity, t_any());
 t_from_term(T) when is_integer(T) ->   t_integer(T);
+t_from_term(T) when is_map(T) ->       t_map();
 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_map(T) ->       t_map();
 t_from_term(T) when is_tuple(T) ->
   t_tuple([t_from_term(E) || E <- tuple_to_list(T)]).
 
@@ -2570,7 +2570,7 @@ 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 = ?number(_, _)) ->     ?number_union(T);
 force_union(T = ?opaque(_)) ->        ?opaque_union(T);
 force_union(T = ?remote(_)) ->        ?remote_union(T);
 force_union(T = ?map(_)) ->           ?map_union(T);
@@ -3581,6 +3581,8 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) ->
 	_ -> T1
       end
   end;
+t_subtract(?map(_) = T, _) ->  % XXX: very crude; will probably need refinement
+  T;
 t_subtract(?product(P1), _) ->
   ?product(P1);
 t_subtract(T, ?product(_)) ->
diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl
index 65876b83ea..ebeb5e2c10 100644
--- a/lib/hipe/icode/hipe_icode_type.erl
+++ b/lib/hipe/icode/hipe_icode_type.erl
@@ -84,15 +84,15 @@
 		    t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_arity/1, 
 		    t_inf/2, t_inf_lists/2, t_integer/0,
 		    t_integer/1, t_is_atom/1, t_is_any/1,
-		    t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, t_is_boolean/1,
-		    t_is_fixnum/1, t_is_cons/1,
+		    t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1,
+		    t_is_boolean/1, t_is_fixnum/1, t_is_cons/1, t_is_map/1,
 		    t_is_maybe_improper_list/1, t_is_equal/2, t_is_float/1,
 		    t_is_fun/1, t_is_integer/1, t_is_non_neg_integer/1, 
 		    t_is_number/1, t_is_matchstate/1,
-		    t_is_nil/1, t_is_none/1, t_is_port/1, t_is_pid/1,
+		    t_is_none/1, t_is_port/1, t_is_pid/1,
 		    t_is_reference/1, t_is_subtype/2, t_is_tuple/1,
 		    t_limit/2, t_matchstate_present/1, t_matchstate/0, 
-		    t_matchstate_slots/1, t_maybe_improper_list/0,
+		    t_matchstate_slots/1, t_maybe_improper_list/0, t_map/0,
 		    t_nil/0, t_none/0, t_number/0, t_number/1, t_number_vals/1,
 		    t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2,
 		    t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]).
@@ -213,7 +213,7 @@ analyse_blocks(Work, State, MFA) ->
       {NewState, NewLabels}  =
 	try analyse_block(Label, Info, State)
 	catch throw:none_type ->
-	    %% io:format("received none type at label: ~p~n",[Label]),
+	    %% io:format("received none type at label: ~p~n", [Label]),
 	    {State,[]}
 	end,
       NewWork2 = add_work(NewWork, NewLabels),
@@ -265,7 +265,7 @@ analyse_insn(I, Info, LookupFun) ->
       do_move(I, Info);
     #icode_call{} ->
       NewInfo = do_call(I, Info, LookupFun),
-      %%io:format("Analysing Call: ~w~n~w~n", [I,NewInfo]),
+      %% io:format("Analysing Call: ~w~n~w~n", [I, NewInfo]),
       update_call_arguments(I, NewInfo);
     #icode_phi{} ->
       Type = t_limit(join_list(hipe_icode:args(I), Info), ?TYPE_DEPTH),
@@ -788,16 +788,16 @@ test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info) ->
   end.
 
 test_type(Test, Type) ->
-  %%io:format("Test is: ~w\n", [Test]),
-  %%io:format("Type is: ~s\n", [format_type(Type)]),
+  %% io:format("Test is: ~w\n", [Test]),
+  %% io:format("Type is: ~s\n", [format_type(Type)]),
   Ans = 
     case t_is_any(Type) of
       true -> maybe;
       false ->
 	TrueTest = true_branch_info(Test),
 	Inf = t_inf(TrueTest, Type),
-	%%io:format("TrueTest is: ~s\n", [format_type(TrueTest)]),
-	%%io:format("Inf is: ~s\n", [format_type(Inf)]),
+	%% io:format("TrueTest is: ~s\n", [format_type(TrueTest)]),
+	%% io:format("Inf is: ~s\n", [format_type(Inf)]),
 	case t_is_equal(Type, Inf) of
 	  true ->
 	    not t_is_none(Type);
@@ -895,11 +895,12 @@ test_type0(boolean, T) ->
   t_is_boolean(T);
 test_type0(list, T) ->
   t_is_maybe_improper_list(T);
-test_type0(cons, T) ->
-  t_is_cons(T);
-test_type0(nil, T) ->
-  t_is_nil(T).
-
+%% test_type0(cons, T) ->
+%%   t_is_cons(T);
+%% test_type0(nil, T) ->
+%%   t_is_nil(T).
+test_type0(map, T) ->
+  t_is_map(T).
 
 true_branch_info(integer) ->
   t_integer();
@@ -931,22 +932,24 @@ true_branch_info(reference) ->
   t_reference();
 true_branch_info(function) ->
   t_fun();
-true_branch_info(cons) ->
-  t_cons();
-true_branch_info(nil) ->
-  t_nil();
+%% true_branch_info(cons) ->
+%%   t_cons();
+%% true_branch_info(nil) ->
+%%   t_nil();
 true_branch_info(boolean) ->
   t_boolean();
+true_branch_info(map) ->
+  t_map();
 true_branch_info(T) ->
-  exit({?MODULE,unknown_typetest,T}).
+  exit({?MODULE, unknown_typetest, T}).
 
 
 %% _________________________________________________________________
 %%
 %% Remove the redundant type tests. If a test is removed, the trace
-%% that isn't taken is explicitly removed from the CFG to simpilify
+%% that isn't taken is explicitly removed from the CFG to simplify
 %% the handling of Phi nodes. If a Phi node is left and at least one
-%% branch into it has disappeared, the SSA propagation pass can't
+%% branch into it has disappeared, the SSA propagation pass cannot
 %% handle it.
 %%
 %% If the CFG has changed at the end of this pass, the analysis is
diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl
index 6ab40adcc8..483d0b37f7 100644
--- a/lib/hipe/rtl/hipe_icode2rtl.erl
+++ b/lib/hipe/rtl/hipe_icode2rtl.erl
@@ -437,6 +437,8 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) ->
       {hipe_tagscheme:test_integer(X, TrueLbl, FalseLbl, Pred), ConstTab};
     list ->
       {hipe_tagscheme:test_list(X, TrueLbl, FalseLbl, Pred), ConstTab};
+    map ->
+      {hipe_tagscheme:test_map(X, TrueLbl, FalseLbl, Pred), ConstTab};
     nil ->
       {hipe_tagscheme:test_nil(X, TrueLbl, FalseLbl, Pred), ConstTab};
     number ->
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
index 4725889d8d..c27c682915 100644
--- a/lib/hipe/rtl/hipe_tagscheme.erl
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -39,7 +39,7 @@
 	 test_tuple/4, test_atom/4, test_bignum/4, test_pos_bignum/4,
 	 test_any_pid/4, test_any_port/4,
 	 test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4,
-	 test_binary/4, test_bitstr/4, test_list/4,
+	 test_binary/4, test_bitstr/4, test_list/4, test_map/4,
 	 test_integer/4, test_number/4, test_tuple_N/5]).
 -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]).
 -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3,
@@ -112,13 +112,15 @@
 -define(TAG_HEADER_EXTERNAL_PID, ((16#C bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
 -define(TAG_HEADER_EXTERNAL_PORT,((16#D bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
 -define(TAG_HEADER_EXTERNAL_REF, ((16#E bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
+-define(TAG_HEADER_MAP,     ((16#F bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)).
 
 -define(TAG_HEADER_MASK, 16#3F).
 -define(HEADER_ARITY_OFFS, 6).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-mk_header(SZ,TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG.
+mk_header(SZ, TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG.
+
 mk_arityval(SZ)	-> mk_header(SZ, ?TAG_HEADER_ARITYVAL).
 
 size_from_header(Sz, Header) ->
@@ -132,9 +134,9 @@ mk_var_header(Header, Size, Tag) ->
 mk_fixnum(X) -> (X bsl ?TAG_IMMED1_SIZE) + ?TAG_IMMED1_SMALL.
 
 -define(NIL, ((-1 bsl ?TAG_IMMED2_SIZE) bor ?TAG_IMMED2_NIL)).
-mk_nil()	-> ?NIL.
-%% mk_atom(X)	-> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM.
-mk_non_value()	-> ?THE_NON_VALUE.
+mk_nil()       -> ?NIL.
+%% mk_atom(X)  -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM.
+mk_non_value() -> ?THE_NON_VALUE.
 
 -spec is_fixnum(integer()) -> boolean().
 is_fixnum(N) when is_integer(N) ->
@@ -252,6 +254,15 @@ test_tuple_N(X, N, TrueLab, FalseLab, Pred) ->
    hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(mk_arityval(N)),
 		      TrueLab, FalseLab, Pred)].
 
+test_map(X, TrueLab, FalseLab, Pred) ->
+  Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+  HalfTrueLab = hipe_rtl:mk_new_label(),
+  MapMask = ?TAG_HEADER_MASK,
+  [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+   HalfTrueLab,
+   get_header(Tmp, X),
+   mask_and_compare(Tmp, MapMask, ?TAG_HEADER_MAP, TrueLab, FalseLab, Pred)].
+
 test_ref(X, TrueLab, FalseLab, Pred) ->
   Hdr = hipe_rtl:mk_new_reg_gcsafe(),
   Tag = hipe_rtl:mk_new_reg_gcsafe(),