File 3506-erl_eval-Implement-support-for-maybe-.-end.patch of Package erlang
From 05b1d96a6a2a9980ad75bdc2e717b572149f6a7b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 8 Nov 2021 14:22:21 +0100
Subject: [PATCH 06/12] erl_eval: Implement support for maybe ... end
---
lib/stdlib/src/erl_eval.erl | 41 ++++++++++++++
lib/stdlib/src/shell.erl | 8 ++-
lib/stdlib/test/Makefile | 3 +-
lib/stdlib/test/epp_SUITE.erl | 4 +-
lib/stdlib/test/erl_eval_SUITE.erl | 82 ++++++++++++++++++++++++++--
lib/stdlib/test/io_proto_SUITE.erl | 8 +--
lib/stdlib/test/supervisor_SUITE.erl | 4 +-
7 files changed, 136 insertions(+), 14 deletions(-)
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index fc2e2a4194..987ba0cf0a 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -136,6 +136,32 @@ exprs([E|Es], Bs0, Lf, Ef, RBs, FUVs) ->
{value,_V,Bs} = expr(E, Bs0, Lf, Ef, RBs1, FUVs),
exprs(Es, Bs, Lf, Ef, RBs, FUVs).
+%% maybe_match_exprs(Expression, Bindings, LocalFuncHandler, ExternalFuncHandler)
+%% Returns one of:
+%% {success,Value}
+%% {failure,Value}
+%% or raises an exception.
+
+maybe_match_exprs([{maybe_match,Anno,Lhs,Rhs0}|Es], Bs0, Lf, Ef) ->
+ {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none),
+ case match(Lhs, Rhs, Anno, Bs1, Bs1, Ef) of
+ {match,Bs} ->
+ case Es of
+ [] ->
+ {success,Rhs};
+ [_|_] ->
+ maybe_match_exprs(Es, Bs, Lf, Ef)
+ end;
+ nomatch ->
+ {failure,Rhs}
+ end;
+maybe_match_exprs([E], Bs0, Lf, Ef) ->
+ {value,V,_Bs} = expr(E, Bs0, Lf, Ef, none),
+ {success,V};
+maybe_match_exprs([E|Es], Bs0, Lf, Ef) ->
+ {value,_V,Bs} = expr(E, Bs0, Lf, Ef, none),
+ maybe_match_exprs(Es, Bs, Lf, Ef).
+
%% expr(Expression, Bindings)
%% expr(Expression, Bindings, LocalFuncHandler)
%% expr(Expression, Bindings, LocalFuncHandler, ExternalFuncHandler)
@@ -469,6 +495,21 @@ expr({match,Anno,Lhs,Rhs0}, Bs0, Lf, Ef, RBs, FUVs) ->
ret_expr(Rhs, Bs, RBs);
nomatch -> apply_error({badmatch,Rhs}, ?STACKTRACE, Anno, Bs0, Ef, RBs)
end;
+expr({'maybe',_,Es}, Bs, Lf, Ef, RBs, _FUVs) ->
+ {_,Val} = maybe_match_exprs(Es, Bs, Lf, Ef),
+ ret_expr(Val, Bs, RBs);
+expr({'maybe',Anno,Es,{'else',_,Cs}}, Bs0, Lf, Ef, RBs, FUVs) ->
+ case maybe_match_exprs(Es, Bs0, Lf, Ef) of
+ {success,Val} ->
+ ret_expr(Val, Bs0, RBs);
+ {failure,Val} ->
+ case match_clause(Cs, [Val], Bs0, Lf, Ef) of
+ {B, Bs} ->
+ exprs(B, Bs, Lf, Ef, RBs, FUVs);
+ nomatch ->
+ apply_error({else_clause,Val}, ?STACKTRACE, Anno, Bs0, Ef, RBs)
+ end
+ end;
expr({op,Anno,Op,A0}, Bs0, Lf, Ef, RBs, FUVs) ->
{value,A,Bs} = expr(A0, Bs0, Lf, Ef, none, FUVs),
eval_op(Op, A, Anno, Bs, Ef, RBs);
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 06372d9baa..cc147848e3 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -273,11 +273,17 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) ->
end.
get_command(Prompt, Eval, Bs, RT, Ds) ->
+ ResWordFun =
+ fun('maybe') -> true;
+ ('else') -> true;
+ (Other) -> erl_scan:reserved_word(Other)
+ end,
Parse =
fun() ->
exit(
case
- io:scan_erl_exprs(group_leader(), Prompt, {1,1}, [text])
+ io:scan_erl_exprs(group_leader(), Prompt, {1,1},
+ [text,{reserved_word_fun,ResWordFun}])
of
{ok,Toks,_EndPos} ->
erl_eval:extended_parse_exprs(Toks);
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 6b2711089b..382efd2803 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -118,9 +118,10 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test
# FLAGS
# ----------------------------------------------------
+MAYBE_OPT = '+{enable_feature,maybe_expr}'
ERL_MAKE_FLAGS +=
ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/include \
- -I$(ERL_TOP)/lib/stdlib/include
+ -I$(ERL_TOP)/lib/stdlib/include $(MAYBE_OPT)
EBIN = .
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 9a4b430c88..30437de302 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -941,7 +941,7 @@ ifdef(Config) ->
"-else.\n"
"t() -> a.\n"
"-endif.\n">>,
- {errors,[{{3,1},epp,{bad,else}}],[]}},
+ {errors,[{{3,1},epp,{bad,'else'}}],[]}},
{ifdef_c8,
<<"-ifdef(a).\n"
@@ -1802,7 +1802,7 @@ otp_16824(Config) when is_list(Config) ->
{otp_16824_8,
<<"\n-else\n"
"-endif.">>,
- {errors,[{{3,1},epp,{bad,else}}],[]}},
+ {errors,[{{3,1},epp,{bad,'else'}}],[]}},
{otp_16824_9,
<<"\n-ifndef.\n"
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index 16a92f7ff5..6c8d79dbfc 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -54,6 +54,7 @@
otp_14708/1,
otp_16545/1,
otp_16865/1,
+ eep49/1,
binary_skip/1]).
%%
@@ -95,7 +96,7 @@ all() ->
otp_8133, otp_10622, otp_13228, otp_14826,
funs, custom_stacktrace, try_catch, eval_expr_5, zero_width,
eep37, eep43, otp_15035, otp_16439, otp_14708, otp_16545, otp_16865,
- binary_skip].
+ eep49, binary_skip].
groups() ->
[].
@@ -1899,6 +1900,67 @@ otp_16865(Config) when is_list(Config) ->
{badmatch, b}),
ok.
+eep49(Config) when is_list(Config) ->
+ check(fun() ->
+ maybe empty end
+ end,
+ "maybe empty end.",
+ empty),
+ check(fun() ->
+ maybe ok ?= ok end
+ end,
+ "maybe ok ?= ok end.",
+ ok),
+ check(fun() ->
+ maybe {ok,A} ?= {ok,good}, A end
+ end,
+ "maybe {ok,A} ?= {ok,good}, A end.",
+ good),
+ check(fun() ->
+ maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} end
+ end,
+ "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} end.",
+ {good,also_good}),
+ check(fun() ->
+ maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,wrong}, {A,B} end
+ end,
+ "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,wrong}, {A,B} end.",
+ {error,wrong}),
+
+ %% Test maybe ... else ... end.
+ check(fun() ->
+ maybe empty else _ -> error end
+ end,
+ "maybe empty else _ -> error end.",
+ empty),
+ check(fun() ->
+ maybe ok ?= ok else _ -> error end
+ end,
+ "maybe ok ?= ok else _ -> error end.",
+ ok),
+ check(fun() ->
+ maybe ok ?= other else _ -> error end
+ end,
+ "maybe ok ?= other else _ -> error end.",
+ error),
+ check(fun() ->
+ maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B}
+ else {error,_} -> error end
+ end,
+ "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {ok,also_good}, {A,B} "
+ "else {error,_} -> error end.",
+ {good,also_good}),
+ check(fun() ->
+ maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,other}, {A,B}
+ else {error,_} -> error end
+ end,
+ "maybe {ok,A} ?= {ok,good}, {ok,B} ?= {error,other}, {A,B} "
+ "else {error,_} -> error end.",
+ error),
+ error_check("maybe ok ?= simply_wrong else {error,_} -> error end.",
+ {else_clause,simply_wrong}),
+ ok.
+
binary_skip(Config) when is_list(Config) ->
check(fun() -> X = 32, [X || <<X:64/float>> <= <<-1:64, 0:64, 0:64, 0:64>>] end,
"begin X = 32, [X || <<X:64/float>> <= <<-1:64, 0:64, 0:64, 0:64>>] end.",
@@ -2030,15 +2093,26 @@ eval_string(String) ->
Result.
parse_expr(String) ->
- {ok,Tokens,_} = erl_scan:string(String),
+ Tokens = erl_scan_string(String),
{ok, [Expr]} = erl_parse:parse_exprs(Tokens),
Expr.
parse_exprs(String) ->
- {ok,Tokens,_} = erl_scan:string(String),
+ Tokens = erl_scan_string(String),
{ok, Exprs} = erl_parse:parse_exprs(Tokens),
Exprs.
+erl_scan_string(String) ->
+ %% FIXME: When the experimental features EEP has been implemented, we should
+ %% dig out all keywords defined in all features.
+ ResWordFun =
+ fun('maybe') -> true;
+ ('else') -> true;
+ (Other) -> erl_scan:reserved_word(Other)
+ end,
+ {ok,Tokens,_} = erl_scan:string(String, 1, [{reserved_word_fun,ResWordFun}]),
+ Tokens.
+
parse_and_run(String) ->
erl_eval:expr(parse_expr(String), []).
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index df6958cfa9..f80cd0794e 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -1179,7 +1179,7 @@ get_and_put(CPid, [{getline_pred,Pred,Msg}|T]=T0, N)
"(command number ~p)\n",
[?MODULE,Msg,N]),
{error, no_match};
- maybe ->
+ 'maybe' ->
List = get(getline_skipped),
put(getline_skipped, List ++ [Data]),
get_and_put(CPid, T0, N)
@@ -1190,7 +1190,7 @@ get_and_put(CPid, [{getline, Match}|T],N) ->
F = fun(Data) ->
case lists:prefix(Match, Data) of
true -> yes;
- false -> maybe
+ false -> 'maybe'
end
end,
get_and_put(CPid, [{getline_pred,F,Match}|T], N);
@@ -1198,7 +1198,7 @@ get_and_put(CPid, [{getline_re, Match}|T],N) ->
F = fun(Data) ->
case re:run(Data, Match, [{capture,none}]) of
match -> yes;
- _ -> maybe
+ _ -> 'maybe'
end
end,
get_and_put(CPid, [{getline_pred,F,Match}|T], N);
@@ -1498,7 +1498,7 @@ get_default_shell() ->
case re:run(Data, "<\\d+[.]\\d+[.]\\d+>",
[{capture,none}]) of
match -> no;
- _ -> maybe
+ _ -> 'maybe'
end
end
end,
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index a52c5b1b44..78d7e7d7bc 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -904,7 +904,7 @@ child_specs_map(Config) when is_list(Config) ->
B7 = CS0#{type => wrker},
B8 = CS0#{modules => dy},
B9 = CS0#{modules => [1,2,3]},
- B10 = CS0#{significant => maybe},
+ B10 = CS0#{significant => 'maybe'},
{error, missing_id} = supervisor:start_child(sup_test, B1),
{error, missing_start} = supervisor:start_child(sup_test, B2),
@@ -932,7 +932,7 @@ child_specs_map(Config) when is_list(Config) ->
{error, {invalid_modules,dy}} = supervisor:check_childspecs([B8]),
{error, {invalid_module, 1}} =
supervisor:check_childspecs([B9]),
- {error, {invalid_significant, maybe}} =
+ {error, {invalid_significant, 'maybe'}} =
supervisor:check_childspecs([B10]),
CSFilter = fun (CS) -> maps:filter(fun (_, V) -> V =/= undefined end, CS) end,
--
2.34.1