File 2401-Fully-support-maps-in-ms_transform.patch of Package erlang
From cc043f8a7d52ad48b41bb9dd89e199d811d09164 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?P=C3=A9ter=20G=C3=B6m=C3=B6ri?= <gomoripeti@gmail.com>
Date: Sat, 29 May 2021 12:55:58 +0200
Subject: [PATCH] Fully support maps in ms_transform
Before this change only map patterns worked and only in the shell via a
hack in `normalise/1` (It converted a map pattern AST to map, but it did
not convert a map expressions AST).
Now the transformation takes care of map patterns in MS head and map
expressions in MS guards/body and `normalise/1` only does what
`erl_parse:normalise/1`. Checking restrictions on map keys and values is
left to the PAM machine.
---
lib/stdlib/src/ms_transform.erl | 21 +++++---
lib/stdlib/test/ms_transform_SUITE.erl | 70 ++++++++++++++++++++++++--
lib/stdlib/test/qlc_SUITE.erl | 6 +--
3 files changed, 83 insertions(+), 14 deletions(-)
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index f38b0eb905..dde8e572a3 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -756,7 +756,12 @@ tg({bin_element,Anno,X,Y,Z},B) ->
tg({bin,Anno,List},B) ->
{bin,Anno,[tg(X,B) || X <- List]};
-
+
+tg({map_field_assoc, Anno, Field, Value}, B) ->
+ {map_field_assoc, Anno, tg(Field, B), tg(Value, B)};
+tg({map, Anno, List}, B) ->
+ {map, Anno, [tg(X, B) || X <- List]};
+
tg(T,B) when is_tuple(T), tuple_size(T) >= 2 ->
Element = element(1,T),
Anno = element(2,T),
@@ -858,6 +863,9 @@ th({var,Anno,Name},B,OB) ->
Trans ->
{{atom,Anno,Trans},B}
end;
+th({map_field_exact,Anno,Field,Value},B,OB) ->
+ {[NField, NValue], NB} = th([Field, Value], B, OB),
+ {{map_field_assoc,Anno,NField,NValue}, NB};
th([H|T],B,OB) ->
{NH,NB} = th(H,B,OB),
{NT,NNB} = th(T,NB,OB),
@@ -1134,12 +1142,11 @@ normalise({op,_,'++',A,B}) ->
normalise(A) ++ normalise(B);
normalise({tuple,_,Args}) ->
list_to_tuple(normalise_list(Args));
-normalise({map,_,Pairs0}) ->
- Pairs1 = lists:map(fun ({map_field_exact,_,K,V}) ->
- {normalise(K),normalise(V)}
- end,
- Pairs0),
- maps:from_list(Pairs1);
+normalise({map,_,Pairs}) ->
+ maps:from_list(lists:map(fun
+ %% only allow '=>'
+ ({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)}
+ end, Pairs));
%% Special case for unary +/-.
normalise({op,_,'+',{char,_,I}}) -> I;
normalise({op,_,'+',{integer,_,I}}) -> I;
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index c9dc7e5c1d..c34c7e9e69 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -30,8 +30,14 @@
-export([from_shell/1]).
-export([records/1]).
-export([record_index/1]).
--export([multipass/1]).
+-export([map_pattern/1]).
+-export([map_expr_in_head/1]).
+-export([map_pattern_from_shell/1]).
+-export([map_expr_in_head_from_shell/1]).
+-export([map_exprs/1]).
+-export([map_exprs_from_shell/1]).
-export([top_match/1]).
+-export([multipass/1]).
-export([old_guards/1]).
-export([autoimported/1]).
-export([semicolon/1]).
@@ -63,7 +69,10 @@ all() ->
record_index, multipass, bitsyntax, binary_bifs, record_defaults,
andalso_orelse, float_1_function, action_function,
warnings, no_warnings, top_match, old_guards, autoimported,
- semicolon, eep37, otp_14454, otp_16824, unused_record].
+ semicolon, eep37, otp_14454, otp_16824, unused_record,
+ map_pattern, map_expr_in_head,
+ map_pattern_from_shell, map_expr_in_head_from_shell,
+ map_exprs, map_exprs_from_shell].
groups() ->
[].
@@ -316,7 +325,7 @@ basic_ets(Config) when is_list(Config) ->
compile_and_run(<<"ets:fun2ms(fun({\"foo\" ++ _, X}) -> X end)">>),
ok.
-%% Tests basic ets:fun2ms.
+%% Tests basic dbg:fun2ms.
basic_dbg(Config) when is_list(Config) ->
setup(Config),
[{[a,b],[],[{message,banan},{return_trace}]}] =
@@ -409,6 +418,59 @@ record_index(Config) when is_list(Config) ->
<<"ets:fun2ms(fun({#a.a,A}) when A > #a.a -> #a.a end)">>),
ok.
+map_pattern(Config) when is_list(Config) ->
+ setup(Config),
+ MS = [{{key, #{foo => '$1'}},[],['$1']}],
+ MS = compile_and_run(<<"ets:fun2ms(fun({key, #{foo := V}}) -> V end)">>),
+ ok.
+
+map_expr_in_head(Config) when is_list(Config) ->
+ setup(Config),
+ MS = [{{key, #{foo => '$1'}},[],['$1']}],
+ %% Accidentally it is possible to use => instead of := in the fun head,
+ %% in compiled code.
+ %% Although this is not an intended behaviour it is kept to
+ %% maintain backwards compatibility.
+ MS = compile_and_run(<<"ets:fun2ms(fun({key, #{foo => V}}) -> V end)">>),
+ ok.
+
+map_pattern_from_shell(Config) when is_list(Config) ->
+ MS = [{{key, #{foo => '$1'}},[],['$1']}],
+ MS = do_eval("ets:fun2ms(fun({key, #{foo := V}}) -> V end)"),
+ ok.
+
+map_expr_in_head_from_shell(Config) when is_list(Config) ->
+ setup(Config),
+ MS = [{{key, #{foo => '$1'}},[],['$1']}],
+ %% Accidentally it is possible to use => instead of := in the fun head,
+ %% in compiled code. This behaviour is kept for backwards compatibility.
+
+ %% As a side-effect, it is also possible to do the same with
+ %% `transform_from_shell/3', if the AST of the shell fun is
+ %% created bypassing the linter. (The linter would prevent
+ %% constructing such invalid syntax, so normally this is not
+ %% possible in the Erlang shell)
+ MS = do_eval("ets:fun2ms(fun({key, #{foo => V}}) -> V end)"),
+ ok.
+
+map_exprs(Config) when is_list(Config) ->
+ setup(Config),
+ MSGuard = [{{key,'$1','$2'}, [{'=:=','$1',#{foo => '$2'}}], ['$1']}],
+ MSGuard = compile_and_run(
+ <<"ets:fun2ms(fun({key, V1, V2}) when V1 =:= #{foo => V2} -> V1 end)">>),
+ MSBody = [{{key,'$1'}, [], [#{foo => '$1'}]}],
+ MSBody = compile_and_run(
+ <<"ets:fun2ms(fun({key, V}) -> #{foo => V} end)">>),
+ ok.
+
+map_exprs_from_shell(Config) when is_list(Config) ->
+ setup(Config),
+ MSGuard = [{{key,'$1','$2'}, [{'=:=','$1',#{foo => '$2'}}], ['$1']}],
+ MSGuard = do_eval("ets:fun2ms(fun({key, V1, V2}) when V1 =:= #{foo => V2} -> V1 end)"),
+ MSBody = [{{key,'$1'}, [], [#{foo => '$1'}]}],
+ MSBody = do_eval("ets:fun2ms(fun({key, V}) -> #{foo => V} end)"),
+ ok.
+
%% Tests matching on top level in head to give alias for object().
top_match(Config) when is_list(Config) ->
setup(Config),
@@ -924,5 +986,5 @@ do_eval(String) ->
[],
String++".\n",1),
{ok,Tree} = erl_parse:parse_exprs(T),
- {value,Res,[]} = erl_eval:exprs(Tree,[]),
+ {value,Res,[]} = erl_eval:exprs(Tree,[],none,none),
Res.
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 3bbb2a7e45..74c8aabf8e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -2632,9 +2632,9 @@ info(Config) when is_list(Config) ->
L = [{#{k => #{v => Fun}}, Fun}],
H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
L = qlc:e(H),
- {call,_,_,[{lc,_,{var,_,'Q'},
- [{generate,_,_,_},
- {op,_,_,_,_}]}]} =
+ {call,_,{remote,_,{atom,_,ets},{atom,_,match_spec_run}},
+ [_,
+ {call,_,{remote,_,{atom,_,ets},{atom,_,match_spec_compile}},[_]}]} =
qlc:info(H, [{format,abstract_code}])">>
],
--
2.34.1
