1 files changed, 141 insertions, 98 deletions

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 6fdeea51d1..ed8f609082 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -72,7 +72,7 @@
 -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
 		reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).
 
--import(cerl, [ann_c_cons/3,ann_c_tuple/2]).
+-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
 
 -include("core_parse.hrl").
 
@@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
 	value ->
 	    ann_c_tuple(Anno, Es)
     end;
-expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
+expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
     Es = pair_list(Es0, Ctxt, Sub),
     case Ctxt of
 	effect ->
@@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
 	    expr(make_effect_seq(Es, Sub), Ctxt, Sub);
 	value ->
 	    V = expr(V0, Ctxt, Sub),
-	    Map#c_map{var=V,es=Es}
+	    ann_c_map(Anno,V,Es)
     end;
 expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
     %% Warn for useless building, but always build the binary
@@ -1229,6 +1229,11 @@ is_non_numeric([H|T]) ->
     is_non_numeric(H) andalso is_non_numeric(T);
 is_non_numeric(Tuple) when is_tuple(Tuple) ->
     is_non_numeric_tuple(Tuple, tuple_size(Tuple));
+is_non_numeric(Map) when is_map(Map) ->
+    %% Note that 17.x and 18.x compare keys in different ways.
+    %% Be very conservative -- require that both keys and values
+    %% are non-numeric.
+    is_non_numeric(maps:to_list(Map));
 is_non_numeric(Num) when is_number(Num) ->
     false;
 is_non_numeric(_) -> true.
@@ -1338,9 +1343,12 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
 	{ok,#c_tuple{es=Elements}} ->
 	    if
 		1 =< Pos, Pos =< length(Elements) ->
-		    case lists:nth(Pos, Elements) of
-			#c_alias{var=Alias} -> Alias;
-			Res -> Res
+		    El = lists:nth(Pos, Elements),
+		    try
+			pat_to_expr(El)
+		    catch
+			throw:impossible ->
+			    Call
 		    end;
 		true ->
 		    eval_failure(Call, badarg)
@@ -1378,6 +1386,7 @@ eval_is_record(Call, _, _, _, _) -> Call.
 is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true;
 is_not_integer(#c_tuple{}) -> true;
 is_not_integer(#c_cons{}) -> true;
+is_not_integer(#c_map{}) -> true;
 is_not_integer(_) -> false.
 
 %% is_not_tuple(Core) -> true | false.
@@ -1385,6 +1394,7 @@ is_not_integer(_) -> false.
 
 is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true;
 is_not_tuple(#c_cons{}) -> true;
+is_not_tuple(#c_map{}) -> true;
 is_not_tuple(_) -> false.
 
 %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
@@ -1554,16 +1564,8 @@ map_pair_pattern_list(Ps0, Isub, Osub0) ->
     {Ps,Osub}.
 
 map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) ->
-    {K,Osub1} = case cerl:type(K0) of
-	binary ->
-	    K1 = eval_binary(K0),
-	    case cerl:type(K1) of
-		literal -> {K1,Osub0};
-		_ -> pattern(K0,Isub,Osub0)
-	    end;
-	_ -> pattern(K0,Isub,Osub0)
-    end,
-    {V,Osub} = pattern(V0,Isub,Osub1),
+    K = expr(K0, Isub),
+    {V,Osub} = pattern(V0,Isub,Osub0),
     {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}.
 
 bin_pattern_list(Ps0, Isub, Osub0) ->
@@ -1810,9 +1812,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
 	true ->
 	    %% This clause will match.
 	    C = C0#c_clause{body=opt_bool_case(B)},
-	    case Lit of
-		false -> [C|opt_bool_clauses(Cs, SeenT, true)];
-		true -> [C|opt_bool_clauses(Cs, true, SeenF)]
+	    case {Lit,SeenT,SeenF} of
+                {false,_,false} ->
+                    [C|opt_bool_clauses(Cs, SeenT, true)];
+                {true,false,_} ->
+                    [C|opt_bool_clauses(Cs, true, SeenF)];
+                _ ->
+                    add_warning(C, nomatch_shadow),
+                    opt_bool_clauses(Cs, SeenT, SeenF)
 	    end
     end;
 opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
@@ -2024,9 +2031,9 @@ case_opt(Arg, Cs0, Sub) ->
 
 case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) ->
     case case_opt_arg(A0, Sub, Cs0, LitExpr) of
-	error ->
+        {error,Cs1} ->
 	    %% Nothing to be done. Move on to the next argument.
-	    Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0],
+            Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs1],
 	    case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]);
 	{ok,As1,Cs} ->
 	    %% The argument was either expanded (from tuple/list) or
@@ -2041,17 +2048,18 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
 %%  Try to expand one argument to several arguments (if tuple/list)
 %%  or to remove a literal argument.
 %%
-case_opt_arg(E0, Sub, Cs, LitExpr) ->
+case_opt_arg(E0, Sub, Cs0, LitExpr) ->
     E = maybe_replace_var(E0, Sub),
     case cerl:is_data(E) of
 	false ->
-	    error;
+            {error,Cs0};
 	true ->
+	    Cs = case_opt_nomatch(E, Cs0, LitExpr),
 	    case cerl:data_type(E) of
 		{atomic,_} ->
-		    case_opt_lit(E, Cs, LitExpr);
+		    case_opt_lit(E, Cs);
 		_ ->
-		    case_opt_data(E, Cs, LitExpr)
+		    case_opt_data(E, Cs)
 	    end
     end.
 
@@ -2073,19 +2081,67 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
 		false ->
 		    E;
 		true ->
-		    cerl_trees:map(fun(C) ->
-					   case cerl:is_c_alias(C) of
-					       false -> C;
-					       true -> cerl:alias_pat(C)
-					   end
-				   end, T0)
+		    %% The pattern was a tuple. Now we must make sure
+		    %% that the elements of the tuple are suitable. In
+		    %% particular, we don't want binary or map
+		    %% construction here, since that means that the
+		    %% binary or map will be constructed in the 'case'
+		    %% argument. That is wasteful for binaries. Even
+		    %% worse is that any map pattern that use the ':='
+		    %% operator will fail when used in map
+		    %% construction (only the '=>' operator is allowed
+		    %% when constructing a map from scratch).
+		    ToData = fun coerce_to_data/1,
+		    try
+			cerl_trees:map(ToData, T0)
+		    catch
+			throw:impossible ->
+			    %% Something unsuitable was found (map or
+			    %% or binary). Keep the variable.
+			    E
+		    end
 	    end;
 	error ->
 	    E
     end.
 
-%% case_opt_lit(Literal, Clauses0, LitExpr) ->
-%%           {ok,[],Clauses} | error
+%% coerce_to_data(Core) -> Core'
+%%  Coerce an element originally from a pattern to an data item or or
+%%  variable. Throw an 'impossible' exception if non-data Core Erlang
+%%  terms such as binary construction or map construction are
+%%  encountered.
+
+coerce_to_data(C) ->
+    case cerl:is_c_alias(C) of
+	false ->
+	    case cerl:is_data(C) orelse cerl:is_c_var(C) of
+		true -> C;
+		false -> throw(impossible)
+	    end;
+	true ->
+	    coerce_to_data(cerl:alias_pat(C))
+    end.
+
+%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses'
+%%  Remove all clauses that cannot possibly match.
+
+case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) ->
+    case cerl_clauses:match(P, E) of
+        none ->
+            %% The pattern will not match the case expression. Remove
+            %% the clause.  Unless the entire case expression is a
+            %% literal, also emit a warning.
+            case LitExpr of
+                false -> add_warning(C, nomatch_clause_type);
+                true -> ok
+            end,
+            case_opt_nomatch(E, Cs, LitExpr);
+        _ ->
+            [Current|case_opt_nomatch(E, Cs, LitExpr)]
+    end;
+case_opt_nomatch(_, [], _) -> [].
+
+%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error
 %%  The current part of the case expression is a literal. That
 %%  means that we will know at compile-time whether a clause
 %%  will match, and we can remove the corresponding pattern from
@@ -2094,59 +2150,48 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
 %%  The only complication is if the literal is a binary. Binary
 %%  pattern matching is tricky, so we will give up in that case.
 
-case_opt_lit(Lit, Cs0, LitExpr) ->
-    try case_opt_lit_1(Cs0, Lit, LitExpr) of
+case_opt_lit(Lit, Cs0) ->
+    try case_opt_lit_1(Lit, Cs0) of
 	Cs ->
 	    {ok,[],Cs}
     catch
 	throw:impossible ->
-	    error
+            {error,Cs0}
     end.
 
-case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) ->
+case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) ->
+    %% Non-matching clauses have already been removed
+    %% in case_opt_nomatch/3.
     case cerl_clauses:match(P, E) of
-	none ->
-	    %% The pattern will not match the literal. Remove the clause.
-	    %% Unless the entire case expression is a literal, also
-	    %% emit a warning.
-	    case LitExpr of
-		false -> add_warning(C, nomatch_clause_type);
-		true -> ok
-	    end,
-	    case_opt_lit_1(Cs, E, LitExpr);
 	{true,Bs} ->
 	    %% The pattern matches the literal. Remove the pattern
 	    %% and update the bindings.
-	    [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)];
+            [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)];
 	{false,_} ->
 	    %% Binary literal and pattern. We are not sure whether
 	    %% the pattern will match.
 	    throw(impossible)
     end;
-case_opt_lit_1([], _, _) -> [].
+case_opt_lit_1(_, []) -> [].
 
 %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
 
-case_opt_data(E, Cs0, LitExpr) ->
+case_opt_data(E, Cs0) ->
     Es = cerl:data_es(E),
-    Cs = case_opt_data_1(Cs0, Es,
-			 {cerl:data_type(E),cerl:data_arity(E)},
-			 LitExpr),
-    {ok,Es,Cs}.
-
-case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) ->
-    case case_data_pat(P, TypeSig) of
-	{ok,Ps1,Bs1} ->
-	    [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
-	     case_opt_data_1(Cs, Es, TypeSig,LitExpr)];
-	error ->
-	    case LitExpr of
-		false -> add_warning(C, nomatch_clause_type);
-		true -> ok
-	    end,
-	    case_opt_data_1(Cs, Es, TypeSig, LitExpr)
-    end;
-case_opt_data_1([], _, _, _) -> [].
+    TypeSig = {cerl:data_type(E),cerl:data_arity(E)},
+    try case_opt_data_1(Cs0, Es, TypeSig) of
+	Cs ->
+	    {ok,Es,Cs}
+    catch
+	throw:impossible ->
+	    {error,Cs0}
+    end.
+
+case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+    {ok,Ps1,Bs1} = case_data_pat(P, TypeSig),
+    [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
+     case_opt_data_1(Cs, Es, TypeSig)];
+case_opt_data_1([], _, _) -> [].
 
 %% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.
 
@@ -2155,12 +2200,7 @@ case_data_pat(P, TypeSig) ->
 	false ->
 	    case_data_pat_var(P, TypeSig);
 	true ->
-	    case {cerl:data_type(P),cerl:data_arity(P)} of
-		TypeSig ->
-		    {ok,cerl:data_es(P),[]};
-		{_,_} ->
-		    error
-	    end
+	    {ok,cerl:data_es(P),[]}
     end.
 
 %% case_data_pat_var(Pattern, {DataType,ArityType}) ->
@@ -2180,35 +2220,38 @@ case_data_pat_var(P, {Type,Arity}=TypeSig) ->
 	alias ->
 	    V = cerl:alias_var(P),
 	    Apat = cerl:alias_pat(P),
-	    case case_data_pat(Apat, TypeSig) of
-		{ok,Ps,Bs} ->
-		    {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]};
-		error ->
-		    error
-	    end;
-	_ ->
-	    error
+	    {ok,Ps,Bs} = case_data_pat(Apat, TypeSig),
+	    {ok,Ps,[{V,cerl:ann_make_data(Ann, Type,
+					  pat_to_expr_list(Ps))}|Bs]}
     end.
 
-%% unalias_pat(Pattern) -> Pattern.
-%%  Remove all the aliases in a pattern but using the alias variables
-%%  instead of the values.  We KNOW they will be bound.
+%% pat_to_expr(Pattern) -> Expression.
+%%  Convert a pattern to an expression if possible. We KNOW that
+%%  all variables in the pattern will be bound.
+%%
+%%  Throw an 'impossible' exception if a map or (non-literal)
+%%  binary is encountered. Trying to use a map pattern as an
+%%  expression is incorrect, while rebuilding a potentially
+%%  huge binary in an expression would be wasteful.
 
-unalias_pat(P) ->
-    case cerl:is_c_alias(P) of
-	true ->
+pat_to_expr(P) ->
+    case cerl:type(P) of
+	alias ->
 	    cerl:alias_var(P);
-	false ->
+	var ->
+	    P;
+	_ ->
 	    case cerl:is_data(P) of
 		false ->
-		    P;
+		    %% Map or binary.
+		    throw(impossible);
 		true ->
-		    Es = unalias_pat_list(cerl:data_es(P)),
+		    Es = pat_to_expr_list(cerl:data_es(P)),
 		    cerl:update_data(P, cerl:data_type(P), Es)
 	    end
     end.
 
-unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps].
+pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps].
 
 make_vars(A, Max) ->
     make_vars(A, 1, Max).
@@ -2240,23 +2283,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) ->
 
 %% opt_case_in_let(LetExpr) -> LetExpr'
 
-opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
-    opt_case_in_let_0(Vs, Arg, B, Let).
+opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
+    opt_case_in_let_0(Vs, Arg, B, Let, Sub).
 
 opt_case_in_let_0([#c_var{name=V}], Arg,
-		  #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) ->
+		  #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) ->
     case opt_case_in_let_1(V, Arg, Cs) of
 	impossible ->
 	    case is_simple_case_arg(Arg) andalso
 		not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
 		true ->
-		    expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new());
+		    expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub));
 		false ->
 		    Let
 	    end;
 	Expr -> Expr
     end;
-opt_case_in_let_0(_, _, _, Let) -> Let.
+opt_case_in_let_0(_, _, _, Let, _) -> Let.
 
 opt_case_in_let_1(V, Arg, Cs) ->
     try
@@ -2599,7 +2642,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) ->
 		    expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub));
 		true ->
 		    Let = Let0#c_let{vars=Vs,arg=Arg,body=Body},
-		    opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub)
+		    opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub)
 	    end
     end;
 opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
@@ -2622,7 +2665,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
 	    expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub));
 	{Vs,Arg,Body} ->
 	    opt_case_in_let_arg(
-	      opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}),
+	      opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub),
 	      value, Sub)
     end.