From adcc726c36555434204dd0fccd13ed984741a7fb Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 26 Oct 2015 11:50:43 +0100 Subject: Factor out common code to gen.erl --- lib/stdlib/src/gen.erl | 121 ++++++++++++++++++++++++++++++++++-------- lib/stdlib/src/gen_event.erl | 11 ++-- lib/stdlib/src/gen_fsm.erl | 85 ++++------------------------- lib/stdlib/src/gen_server.erl | 112 ++++---------------------------------- 4 files changed, 119 insertions(+), 210 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index a05c2ce6fd..7dd02b84e7 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,8 @@ %%% %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/1, +-export([start/5, start/6, debug_options/2, + name/1, unregister_name/1, get_proc_name/1, get_parent/0, call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -124,7 +125,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) -> init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - case name_register(Name) of + case register_name(Name) of true -> init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options); {false, Pid} -> @@ -297,19 +298,19 @@ where({global, Name}) -> global:whereis_name(Name); where({via, Module, Name}) -> Module:whereis_name(Name); where({local, Name}) -> whereis(Name). -name_register({local, Name} = LN) -> +register_name({local, Name} = LN) -> try register(Name, self()) of true -> true catch error:_ -> {false, where(LN)} end; -name_register({global, Name} = GN) -> +register_name({global, Name} = GN) -> case global:register_name(Name, self()) of yes -> true; no -> {false, where(GN)} end; -name_register({via, Module, Name} = GN) -> +register_name({via, Module, Name} = GN) -> case Module:register_name(Name, self()) of yes -> true; @@ -317,34 +318,108 @@ name_register({via, Module, Name} = GN) -> {false, where(GN)} end. +name({local,Name}) -> Name; +name({global,Name}) -> Name; +name({via,_, Name}) -> Name; +name(Pid) when is_pid(Pid) -> Pid. + +unregister_name({local,Name}) -> + try unregister(Name) of + _ -> ok + catch + _:_ -> ok + end; +unregister_name({global,Name}) -> + _ = global:unregister_name(Name), + ok; +unregister_name({via, Mod, Name}) -> + _ = Mod:unregister_name(Name), + ok; +unregister_name(Pid) when is_pid(Pid) -> + ok. + +get_proc_name(Pid) when is_pid(Pid) -> + Pid; +get_proc_name({local, Name}) -> + case process_info(self(), registered_name) of + {registered_name, Name} -> + Name; + {registered_name, _Name} -> + exit(process_not_registered); + [] -> + exit(process_not_registered) + end; +get_proc_name({global, Name}) -> + case global:whereis_name(Name) of + undefined -> + exit(process_not_registered_globally); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit(process_not_registered_globally) + end; +get_proc_name({via, Mod, Name}) -> + case Mod:whereis_name(Name) of + undefined -> + exit({process_not_registered_via, Mod}); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit({process_not_registered_via, Mod}) + end. + +get_parent() -> + case get('$ancestors') of + [Parent | _] when is_pid(Parent) -> + Parent; + [Parent | _] when is_atom(Parent) -> + name_to_pid(Parent); + _ -> + exit(process_was_not_started_by_proc_lib) + end. + +name_to_pid(Name) -> + case whereis(Name) of + undefined -> + case global:whereis_name(Name) of + undefined -> + exit(could_not_find_registered_name); + Pid -> + Pid + end; + Pid -> + Pid + end. + timeout(Options) -> - case opt(timeout, Options) of - {ok, Time} -> + case lists:keyfind(timeout, 1, Options) of + {_,Time} -> Time; - _ -> + false -> infinity end. spawn_opts(Options) -> - case opt(spawn_opt, Options) of - {ok, Opts} -> + case lists:keyfind(spawn_opt, 1, Options) of + {_,Opts} -> Opts; - _ -> + false -> [] end. -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Opts) -> - case opt(debug, Opts) of - {ok, Options} -> sys:debug_options(Options); - _ -> [] +debug_options(Name, Opts) -> + case lists:keyfind(debug, 1, Opts) of + {_,Options} -> + try sys:debug_options(Options) + catch _:_ -> + error_logger:format( + "~p: ignoring erroneous debug options - ~p~n", + [Name,Options]), + [] + end; + false -> + [] end. format_status_header(TagLine, Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 3d63c19de7..aedc0e7c59 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,16 +147,11 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, _, _, Options) -> process_flag(trap_exit, true), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), proc_lib:init_ack(Starter, {ok, self()}), - Name = name(Name0), loop(Parent, Name, [], Debug, false). -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -spec add_handler(emgr_ref(), handler(), term()) -> term(). add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}). diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 7eabb95548..77d41c0652 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -305,64 +305,11 @@ enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = gen:debug_options(Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent) -> - Parent; - [Parent | _] when is_atom(Parent) -> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function @@ -373,8 +320,8 @@ name_to_pid(Name) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -383,15 +330,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); {stop, Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -400,20 +347,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index c58b1de609..6aaefbbbfe 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -304,9 +304,9 @@ enter_loop(Mod, Options, State, Timeout) -> enter_loop(Mod, Options, State, self(), Timeout). enter_loop(Mod, Options, State, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = debug_options(Name, Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, State, Mod, Timeout, Debug). %%%======================================================================== @@ -323,8 +323,8 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = debug_options(Name, Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -339,15 +339,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %% (Otherwise, the parent process could get %% an 'already_started' error if it immediately %% tried starting the process again.) - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -356,20 +356,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%%======================================================================== %%% Internal functions %%%======================================================================== @@ -858,86 +844,6 @@ error_info(Reason, Name, Msg, State, Debug) -> sys:print_log(Debug), ok. -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_opts(Name, Options); - _ -> [] - end. - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent)-> - Parent; - [Parent | _] when is_atom(Parent)-> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- -- cgit v1.2.3 From 6ace96d3e5c9ac8ace3d8967bcafb3e6a081d9be Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 26 Oct 2015 11:52:17 +0100 Subject: New state machine --- lib/stdlib/src/Makefile | 3 +- lib/stdlib/src/gen_statem.erl | 1095 +++++++++++++++++++++++++++++++++++++++++ lib/stdlib/src/proc_lib.erl | 16 +- lib/stdlib/src/stdlib.app.src | 3 +- 4 files changed, 1108 insertions(+), 9 deletions(-) create mode 100644 lib/stdlib/src/gen_statem.erl (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9f4a446ea0..302834f9d0 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2015. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -85,6 +85,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + gen_statem \ io \ io_lib \ io_lib_format \ diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl new file mode 100644 index 0000000000..9bb5ed013b --- /dev/null +++ b/lib/stdlib/src/gen_statem.erl @@ -0,0 +1,1095 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem). + +%% API +-export( + [start/3,start/4,start_link/3,start_link/4, + stop/1,stop/3, + cast/2,call/2,call/3, + enter_loop/4,enter_loop/5,enter_loop/6, + reply/2]). + +%% gen callbacks +-export( + [init_it/6]). + +%% sys callbacks +-export( + [system_continue/3, + system_terminate/4, + system_code_change/4, + system_get_state/1, + system_replace_state/2, + format_status/2]). + +%% Internal callbacks +-export( + [wakeup_from_hibernate/3]). + +%%%========================================================================== +%%% Interface functions. +%%%========================================================================== + +-type client() :: + {To :: pid(), Tag :: term()}. % Reply-to specifier for call +-type state() :: + atom() | % Calls state callback function State/5 + term(). % Calls state callback function handle_event/5 +-type state_data() :: term(). +-type event_type() :: + {'call',Client :: client()} | 'cast' | + 'info' | 'timeout' | 'internal'. +-type event_predicate() :: % Return true for the event in question + fun((event_type(), term()) -> boolean()). +-type state_op() :: + %% First NewState and NewStateData are set, + %% then all state_operations() are executed in order of + %% apperance. Postponing the current event is performed + %% (iff state_option() 'retry' is 'true'). + %% Lastly pending events are processed or if there are + %% no pending events the server goes into receive + %% or hibernate (iff state_option() 'hibernate' is 'true') + state_option() | state_operation(). +-type state_option() :: + %% The first of each kind in the state_op() list takes precedence + 'retry' | % Postpone the current event to a different (=/=) state + {'retry', Retry :: boolean()} | + 'hibernate' | % Hibernate the server instead of going into receive + {'hibernate', Hibernate :: boolean()} | + {'timeout', % Generate a ('timeout', Msg, ...) event after Time + Time :: timeout(), Msg :: term()}. +-type state_operation() :: + %% These can occur multiple times and are executed in order + %% of appearence in the state_op() list + {'reply', % Reply to a client + Client :: client(), Reply :: term()} | + {'stop', Reason :: term()} | % Stop the server + {'insert_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + {'remove_event', % Remove the oldest matching (=:=) event + EventType :: event_type(), EventContent :: term()} | + {'remove_event', % Remove the oldest event satisfying predicate + EventPredicate :: event_predicate()} | + {'cancel_timer', % Cancel timer and clean up mess(ages) + TimerRef :: reference()} | + {'demonitor', % Demonitor and clean up mess(ages) + MonitorRef :: reference()} | + {'unlink', % Unlink and clean up mess(ages) + Id :: pid() | port()}. + +%% The state machine init function. It is called only once and +%% the server is not running until this function has returned +%% an {ok, ...} tuple. Thereafter the state callbacks are called +%% for all events to this server. +-callback init(Args :: term()) -> + {'ok', state(), state_data()} | + {'ok', state(), state_data(), [state_op()]} | + 'ignore' | + {'stop', Reason :: term()}. + +%% An example callback for a fictive state 'handle_event' +%% that you should avoid having. See below. +%% +%% Note that state callbacks and only state callbacks have arity 5 +%% and that is intended. +%% +%% You should not actually use 'handle_event' as a state name, +%% since it is the callback function that is used if you would use +%% a State that is not an atom(). This is because since there is +%% no obvious way to decide on a state function name from any term(). +-callback handle_event( + event_type(), + EventContent :: term(), + PrevState :: state(), + State :: state(), % Current state + StateData :: state_data()) -> + [state_op()] | % {State,StateData,[state_op()]} + {} | % {State,StateData,[]} + {NewStateData :: state_data()} | % {State,NewStateData,[retry]} + {NewState :: state(), + NewStateData :: state_data()} | % {NewState,NewStateData,[]} + {NewState :: state(), NewStateData :: state_data(), [state_op()]}. + +%% Clean up before the server terminates. +-callback terminate( + Reason :: 'normal' | 'shutdown' | {'shutdown', term()} + | term(), + State :: state(), + StateData :: state_data()) -> + any(). + +%% Note that the new code can expect to get an OldState from +%% the old code version not only in code_change/4 but in the first +%% state callback function called thereafter +-callback code_change( + OldVsn :: term() | {'down', term()}, + OldState :: state(), + OldStateData :: state_data(), + Extra :: term()) -> + {ok, {NewState :: state(), NewStateData :: state_data()}}. + +%% Format the callback module state in some sensible that is +%% often condensed way. For StatusOption =:= 'normal' the perferred +%% return term is [{data,[{"State",FormattedState}]}], and for +%% StatusOption =:= 'terminate' it is just FormattedState. +-callback format_status( + StatusOption, + [ [{Key :: term(), Value :: term()}] | + state() | + state_data()]) -> + Status :: term() when + StatusOption :: 'normal' | 'terminate'. + +-optional_callbacks( + [format_status/2, % Has got a default implementation + handle_event/5]). % Only needed for State not an atom() +%% For every atom() State there has to be a State/5 callback function + +%% Type validation functions +client({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> + true; +client(_) -> + false. +%% +event_type({call,Client}) -> + client(Client); +event_type(Type) -> + case Type of + cast -> + true; + info -> + true; + timeout -> + true; + internal -> + true; + _ -> + false + end. + +%%%========================================================================== +%%% API + +-type server_name() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), Name :: term()} + | {'local', atom()}. +-type server_ref() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()} + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | pid(). +-type debug_opt() :: + {'debug', + Dbgs :: + ['trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}]}. +-type start_opt() :: + debug_opt() + | {'timeout', Time :: timeout()} + | {'spawn_opt', SOpts :: [proc_lib:spawn_option()]}. +-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. + + + +%% Start a state machine +-spec start( + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start(Module, Args, Options) -> + gen:start(?MODULE, nolink, Module, Args, Options). +%% +-spec start( + ServerName :: server_name(), + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start(ServerName, Module, Args, Options) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Options). + +%% Start and link to a state machine +-spec start_link( + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start_link(Module, Args, Options) -> + gen:start(?MODULE, link, Module, Args, Options). +%% +-spec start_link( + ServerName :: server_name(), + Module :: module(), Args :: term(), Options :: [start_opt()]) -> + start_ret(). +start_link(ServerName, Module, Args, Options) -> + gen:start(?MODULE, link, ServerName, Module, Args, Options). + +%% Stop a state machine +-spec stop(ServerRef :: server_ref()) -> ok. +stop(ServerRef) -> + gen:stop(ServerRef). +%% +-spec stop( + ServerRef :: server_ref(), + Reason :: term(), + Timeout :: timeout()) -> ok. +stop(ServerRef, Reason, Timeout) -> + gen:stop(ServerRef, Reason, Timeout). + +%% Send an event to a state machine that arrives with type 'event' +-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast({global,Name}, Msg) -> + try global:send(Name, cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({via,RegMod,Name}, Msg) -> + try RegMod:send(Name, cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> + do_send(ServerRef, cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + do_send(ServerRef, cast(Msg)); +cast(ServerRef, Msg) when is_pid(ServerRef) -> + do_send(ServerRef, cast(Msg)). + +%% Call a state machine (synchronous; a reply is expected) that +%% arrives with type {call,Client} +-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). +call(ServerRef, Request) -> + call(ServerRef, Request, infinity). +%% +-spec call( + ServerRef :: server_ref(), + Request :: term(), + Timeout :: timeout()) -> + Reply :: term(). +call(ServerRef, Request, infinity) -> + try gen:call(ServerRef, '$gen_call', Request, infinity) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,infinity]}}, + erlang:get_stacktrace()) + end; +call(ServerRef, Request, Timeout) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, Timeout) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason,erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is just a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + +%% Reply from a state machine callback to whom awaits in call/2 +-spec reply(Client :: client(), Reply :: term()) -> ok. +reply({To,Tag}, Reply) -> + Msg = {Tag,Reply}, + try To ! Msg of + _ -> + ok + catch + _:_ -> ok + end. + +%% Instead of starting the state machine through start/3,4 +%% or start_link/3,4 turn the current process presumably +%% started by proc_lib into a state machine using +%% the same arguments as you would have returned from init/1 +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data()) -> + no_return(). +enter_loop(Module, Options, State, StateData) -> + enter_loop(Module, Options, State, StateData, self()). +%% +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data(), + Server_or_StateOps :: server_name() | pid() | [state_op()]) -> + no_return(). +enter_loop(Module, Options, State, StateData, Server_or_StateOps) -> + if + is_list(Server_or_StateOps) -> + enter_loop( + Module, Options, State, StateData, + self(), Server_or_StateOps); + true -> + enter_loop( + Module, Options, State, StateData, + Server_or_StateOps, []) + end. +%% +-spec enter_loop( + Module :: module(), Options :: [debug_opt()], + State :: state(), StateData :: state_data(), + Server :: server_name() | pid(), + StateOps :: [state_op()]) -> + no_return(). +enter_loop(Module, Options, State, StateData, Server, StateOps) -> + Parent = gen:get_parent(), + enter(Module, Options, State, StateData, Server, StateOps, Parent). + +%%--------------------------------------------------------------------------- +%% API helpers + +cast(Event) -> + {'$gen_cast',Event}. + +%% Might actually not send the message in case of caught exception +do_send(Proc, Msg) -> + try erlang:send(Proc, Msg, [noconnect]) of + noconnect -> + _ = spawn(erlang, send, [Proc,Msg]), + ok; + ok -> + ok + catch + _:_ -> + ok + end. + +%% Here init_it and all enter_loop functions converge +enter(Module, Options, State, StateData, Server, StateOps, Parent) -> + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Options), + PrevState = make_ref(), + S = #{ + module => Module, + name => Name, + prev_state => PrevState, + state => PrevState, + state_data => StateData, + timer => undefined, + postponed => [], + hibernate => false}, + loop_event_state_ops( + Parent, Debug, S, [], {event,undefined}, + State, StateData, [{retry,false}|StateOps]). + +%%%========================================================================== +%%% gen callbacks + +init_it(Starter, Parent, ServerRef, Module, Args, Options) -> + try Module:init(Args) of + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Options) + catch + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Options); + Class:Reason -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + erlang:raise(Class, Reason, erlang:get_stacktrace()) + end. + +%%--------------------------------------------------------------------------- +%% gen callbacks helpers + +init_result(Starter, Parent, ServerRef, Module, Result, Options) -> + case Result of + {ok,State,StateData} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Options, State, StateData, ServerRef, + [], Parent); + {ok,State,StateData,StateOps} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Options, State, StateData, ServerRef, + StateOps, Parent); + {stop,Reason} -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + exit(Reason); + ignore -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, ignore), + exit(normal); + Other -> + Error = {bad_return_value,Other}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end. + +%%%========================================================================== +%%% sys callbacks + +system_continue(Parent, Debug, S) -> + loop(Parent, Debug, S). + +system_terminate(Reason, _Parent, Debug, S) -> + terminate(Reason, Debug, S, []). + +system_code_change( + #{module := Module, + state := State, + state_data := StateData} = S, + _Mod, OldVsn, Extra) -> + case + try Module:code_change(OldVsn, State, StateData, Extra) + catch + Result -> Result + end + of + {ok,{NewState,NewStateData}} -> + {ok, + S#{ + state := NewState, + state_data := NewStateData}}; + Error -> + Error + end. + +system_get_state(#{state := State, state_data := StateData}) -> + {ok,{State,StateData}}. + +system_replace_state( + StateFun, + #{state := State, + state_data := StateData} = S) -> + {NewState,NewStateData} = Result = StateFun({State,StateData}), + {ok,Result,S#{state := NewState, state_data := NewStateData}}. + +format_status( + Opt, + [PDict,SysState,Parent,Debug, + #{name := Name, postponed := P} = S]) -> + Header = gen:format_status_header("Status for state machine", Name), + Log = sys:get_debug(log, Debug, []), + [{header,Header}, + {data, + [{"Status",SysState}, + {"Parent",Parent}, + {"Logged Events",Log}, + {"Postponed",P}]} | + case format_status(Opt, PDict, S) of + L when is_list(L) -> L; + T -> [T] + end]. + +%%--------------------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%--------------------------------------------------------------------------- + +print_event(Dev, {in,Event}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p received ~s~n", + [Name,event_string(Event)]); +print_event(Dev, {out,Reply,{To,_Tag}}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p sent ~p to ~p~n", + [Name,Reply,To]); +print_event(Dev, {Tag,Event,NewState}, #{name := Name, state := State}) -> + StateString = + case NewState of + State -> + io_lib:format("~p", [State]); + _ -> + io_lib:format("~p => ~p", [State,NewState]) + end, + io:format( + Dev, "*DBG* ~p ~w ~s in state ~s~n", + [Name,Tag,event_string(Event),StateString]). + +event_string(Event) -> + case Event of + {{call,{Pid,_Tag}},Request} -> + io_lib:format("call ~p from ~w", [Request,Pid]); + {Tag,Content} -> + io_lib:format("~w ~p", [Tag,Content]) + end. + +sys_debug(Debug, S, Entry) -> + case Debug of + [] -> + Debug; + _ -> + sys:handle_debug(Debug, fun print_event/3, S, Entry) + end. + +%%%========================================================================== +%%% Internal callbacks + +wakeup_from_hibernate(Parent, Debug, S) -> + %% It is a new message that woke us up so we have to receive it now + loop_receive(Parent, Debug, S). + +%%%========================================================================== +%%% STate Machine engine implementation of proc_lib/gen server + +%% Server loop, consists of all loop* functions +%% and some detours through sys and proc_lib + +%% Entry point for system_continue/3 +loop(Parent, Debug, #{hibernate := Hib} = S) -> + case Hib of + true -> + loop_hibernate(Parent, Debug, S); + false -> + loop_receive(Parent, Debug, S) + end. + +loop_hibernate(Parent, Debug, S) -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}). + +%% Entry point for wakeup_from_hibernate/3 +loop_receive(Parent, Debug, #{timer := Timer} = S) -> + receive + Msg -> + case Msg of + {system,Pid,Req} -> + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, + maps:get(hibernate, S)); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple and therefore + %% not an event and has no event_type(), + %% but this will stand out in the crash report... + terminate(Reason, Debug, S, [EXIT]); + {timeout,Timer,Content} when Timer =/= undefined -> + loop_receive( + Parent, Debug, S, {timeout,Content}, undefined); + _ -> + Event = + case Msg of + {'$gen_call',Client,Request} -> + {{call,Client},Request}; + {'$gen_cast',E} -> + {cast,E}; + _ -> + {info,Msg} + end, + loop_receive(Parent, Debug, S, Event, Timer) + end + end. + +loop_receive(Parent, Debug, S, Event, Timer) -> + NewDebug = sys_debug(Debug, S, {in,Event}), + %% Here the queue of not yet processed events is created + loop_events(Parent, NewDebug, S, [Event], Timer). + +%% Process first event in queue, or if there is none receive a new +%% +%% The loop_event* functions optimize S map handling by dismantling it, +%% passing the parts in arguments to avoid map lookups and construct the +%% new S map in one go on exit. Premature optimization, I know, but +%% the code was way to readable and there were quite some map lookups +%% repeated in different functions. +loop_events(Parent, Debug, S, [], _Timer) -> + loop(Parent, Debug, S); +loop_events( + Parent, Debug, + #{module := Module, + prev_state := PrevState, + state := State, + state_data := StateData} = S, + [{Type,Content} = Event|Events] = Q, Timer) -> + _ = (Timer =/= undefined) andalso + cancel_timer(Timer), + Func = + if + is_atom(State) -> + State; + true -> + handle_event + end, + try Module:Func(Type, Content, PrevState, State, StateData) of + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result) + catch + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result); + error:undef -> + %% Process an undef to check for the simple mistake + %% of calling a nonexistent state function + case erlang:get_stacktrace() of + [{Module,State,[Event,StateData]=Args,_}|Stacktrace] -> + terminate( + error, + {undef_state_function,{Module,State,Args}}, + Stacktrace, + Debug, S, Q); + Stacktrace -> + terminate(error, undef, Stacktrace, Debug, S, Q) + end; + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + terminate(Class, Reason, Stacktrace, Debug, S, Q) + end. + +%% Interprete all callback return value variants +loop_event_result( + Parent, Debug, + #{state := State, state_data := StateData} = S, + Events, Event, Result) -> + case Result of + {} -> % Ignore + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, StateData, []); + {NewStateData} -> % Retry + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, NewStateData, [retry]); + {NewState,NewStateData} -> % Consume + loop_event_state_ops( + Parent, Debug, S, Events, Event, + NewState, NewStateData, []); + {NewState,NewStateData,StateOps} when is_list(StateOps) -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + NewState, NewStateData, StateOps); + StateOps when is_list(StateOps) -> % Stay in state + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, StateData, StateOps); + BadReturn -> + terminate( + {bad_return_value,BadReturn}, Debug, S, [Event|Events]) + end. + +loop_event_state_ops( + Parent, Debug0, #{state := State, postponed := P0} = S, Events, Event, + NewState, NewStateData, StateOps) -> + case collect_state_options(StateOps) of + {Retry,Hibernate,Timeout,Operations} -> + P1 = % Move current event to postponed if Retry + case Retry of + true -> + [Event|P0]; + false -> + P0 + end, + {Q2,P2} = % Move all postponed events to queue if state change + if + NewState =:= State -> + {Events,P1}; + true -> + {lists:reverse(P1, Events),[]} + end, + %% + case process_state_operations( + Operations, Debug0, S, Q2, P2) of + {Debug,Q3,P} -> + NewDebug = + sys_debug( + Debug, S, + case Retry of + true -> + {retry,Event,NewState}; + false -> + {consume,Event,NewState} + end), + {Timer,Q} = + case Timeout of + undefined -> + {undefined,Q3}; + {timeout,0,Msg} -> + %% Pretend the timeout has just been received + {undefined,Q3 ++ [{timeout,Msg}]}; + {timeout,Time,Msg} -> + {erlang:start_timer(Time, self(), Msg),Q3} + end, + loop_events( + Parent, NewDebug, + S#{ + prev_state := State, + state := NewState, + state_data := NewStateData, + timer := Timer, + hibernate := Hibernate, + postponed := P}, + Q, Timer); + [Reason,Debug] -> + terminate(Reason, Debug, S, [Event|Events]); + [Class,Reason,Stacktrace,Debug] -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) + end; + %% + [Reason] -> + terminate(Reason, Debug0, S, [Event|Events]) + end. + +%%--------------------------------------------------------------------------- +%% Server helpers + +collect_state_options(StateOps) -> + collect_state_options( + lists:reverse(StateOps), false, false, undefined, []). +%% Keep the last of each kind +collect_state_options( + [], Retry, Hibernate, Timeout, Operations) -> + {Retry,Hibernate,Timeout,Operations}; +collect_state_options( + [StateOp|StateOps] = SOSOs, Retry, Hibernate, Timeout, Operations) -> + case StateOp of + retry -> + collect_state_options( + StateOps, true, Hibernate, Timeout, Operations); + {retry,NewRetry} when is_boolean(NewRetry) -> + collect_state_options( + StateOps, NewRetry, Hibernate, Timeout, Operations); + {retry,_} -> + [{bad_state_ops,SOSOs}]; + hibernate -> + collect_state_options( + StateOps, Retry, true, Timeout, Operations); + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + collect_state_options( + StateOps, Retry, NewHibernate, Timeout, Operations); + {hibernate,_} -> + [{bad_state_ops,SOSOs}]; + {timeout,infinity,_} -> % Ignore since it will never time out + collect_state_options( + StateOps, Retry, Hibernate, undefined, Operations); + {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> + collect_state_options( + StateOps, Retry, Hibernate, NewTimeout, Operations); + {timeout,_,_} -> + [{bad_state_ops,SOSOs}]; + _ -> % Collect others as operations + collect_state_options( + StateOps, Retry, Hibernate, Timeout, [StateOp|Operations]) + end. + +process_state_operations([], Debug, _S, Q, P) -> + {Debug,Q,P}; +process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> + case Operation of + {reply,{_To,_Tag}=Client,Reply} -> + reply(Client, Reply), + NewDebug = sys_debug(Debug, S, {out,Reply,Client}), + process_state_operations(Operations, NewDebug, S, Q, P); + {stop,Reason} -> + [Reason,Debug]; + {insert_event,Type,Content} -> + case event_type(Type) of + true -> + process_state_operations( + Operations, Debug, S, [{Type,Content}|Q], P); + false -> + [{bad_state_ops,OOs},Debug] + end; + _ -> + %% All others are remove operations + case remove_fun(Operation) of + false -> + process_state_operations( + Operations, Debug, S, Q, P); + undefined -> + [{bad_state_ops,OOs},Debug]; + RemoveFun when is_function(RemoveFun, 2) -> + case remove_event(RemoveFun, Q, P) of + {NewQ,NewP} -> + process_state_operations( + Operations, Debug, S, NewQ, NewP); + Error -> + Error ++ [Debug] + end; + Error -> + Error ++ [Debug] + end + end. + +%% Remove oldest matching event from the queue(s) +remove_event(RemoveFun, Q, P) -> + try + case remove_tail_event(RemoveFun, P) of + false -> + case remove_head_event(RemoveFun, Q) of + false -> + {P,Q}; + NewQ -> + {P,NewQ} + end; + NewP -> + {NewP,Q} + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end. + +%% Do the given state operation and create an event removal predicate fun() +remove_fun({remove_event,Type,Content}) -> + fun (T, C) when T =:= Type, C =:= Content -> true; + (_, _) -> false + end; +remove_fun({remove_event,RemoveFun}) when is_function(RemoveFun, 2) -> + RemoveFun; +remove_fun({cancel_timer,TimerRef}) -> + try cancel_timer(TimerRef) of + false -> + false; + true -> + fun + (info, {timeout,TRef,_}) + when TRef =:= TimerRef -> + true; + (_, _) -> + false + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end; +remove_fun({demonitor,MonitorRef}) -> + try erlang:demonitor(MonitorRef, [flush,info]) of + false -> + false; + true -> + fun (info, {'DOWN',MRef,_,_,_}) + when MRef =:= MonitorRef-> + true; + (_, _) -> + false + end + catch + Class:Reason -> + [Class,Reason,erlang:get_stacktrace()] + end; +remove_fun({unlink,Id}) -> + try unlink(Id) of + true -> + receive + {'EXIT',Id,_} -> + ok + after 0 -> + ok + end, + fun (info, {'EXIT',I,_}) + when I =:= Id -> + true; + (_, _) -> + false + end + catch + Class:Reason -> + {Class,Reason,erlang:get_stacktrace()} + end; +remove_fun(_) -> + undefined. + + +%% Cancel a timer and clense the process mailbox returning +%% false if no such timer message can arrive after this or +%% true otherwise +cancel_timer(TimerRef) -> + case erlang:cancel_timer(TimerRef) of + TimeLeft when is_integer(TimeLeft) -> + false; + false -> + receive + {timeout,TimerRef,_} -> + false + after 0 -> + true + end + end. + + +terminate(Reason, Debug, S, Q) -> + terminate(exit, Reason, [], Debug, S, Q). +%% +terminate( + Class, Reason, Stacktrace, Debug, + #{name := Name, module := Module, + state := State, state_data := StateData} = S, + Q) -> + try Module:terminate(Reason, State, StateData) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, Debug, Name, Q, + format_status(terminate, get(), S)), + erlang:raise(C, R, ST) + end, + case Reason of + normal -> ok; + shutdown -> ok; + {shutdown,_} -> ok; + _ -> + error_info( + Class, Reason, Stacktrace, Debug, Name, Q, + format_status(terminate, get(), S)) + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) + end. + +error_info( + Class, Reason, Stacktrace, Debug, Name, Q, FmtStateData) -> + {FixedReason,FixedStacktrace} = + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = length(Args), + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}}, + ST} + end + end; + _ -> {Reason,Stacktrace} + end, + error_logger:format( + "** State machine ~p terminating~n" ++ + case Q of + [] -> + ""; + _ -> + "** Last event = ~p~n" + end ++ + "** When Server state = ~p~n" ++ + "** Reason for termination = ~w:~p~n" ++ + case FixedStacktrace of + [] -> + ""; + _ -> + "** Stacktrace =~n" + "** ~p~n" + end, + [Name | + case Q of + [] -> + [FmtStateData,Class,FixedReason]; + [Event|_] -> + [Event,FmtStateData,Class,FixedReason] + end] ++ + case FixedStacktrace of + [] -> + []; + _ -> + [FixedStacktrace] + end), + sys:print_log(Debug), + ok. + + +%% Call Module:format_status/2 or return a default value +format_status( + Opt, PDict, + #{module := Module, state := State, state_data := StateData}) -> + case erlang:function_exported(Module, format_status, 2) of + true -> + try Module:format_status(Opt, [PDict,State,StateData]) + catch + Result -> Result; + _:_ -> + format_status_default(Opt, State, StateData) + end; + false -> + format_status_default(Opt, State, StateData) + end. + +%% The default Module:format_status/2 +format_status_default(Opt, State, StateData) -> + SSD = {State,StateData}, + case Opt of + terminate -> + SSD; + _ -> + [{data,[{"State",SSD}]}] + end. + +%%--------------------------------------------------------------------------- +%% Farily general helpers + +%% Return the modified list where the first element that satisfies +%% the RemoveFun predicate is removed, or false if no such element exists. +remove_head_event(_RemoveFun, []) -> + false; +remove_head_event(RemoveFun, [{Tag,Content}|Events]) -> + case RemoveFun(Tag, Content) of + false -> + remove_head_event(RemoveFun, Events); + true -> + Events + end. + +%% Return the modified list where the last element that satisfies +%% the RemoveFun predicate is removed, or false if no such element exists. +remove_tail_event(_RemoveFun, []) -> + false; +remove_tail_event(RemoveFun, [{Tag,Content} = Event|Events]) -> + case remove_tail_event(RemoveFun, Events) of + false -> + RemoveFun(Tag, Content) andalso Events; + NewEvents -> + [Event|NewEvents] + end. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 10c476a6f5..3f79ed0f87 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -472,13 +472,15 @@ trans_init(gen,init_it,[gen_server,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; trans_init(gen,init_it,[gen_server,_,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; -trans_init(gen,init_it,[gen_server,_,_,Module,_,_]) -> +trans_init(gen,init_it,[GenMod,_,_,Module,_,_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; -trans_init(gen,init_it,[gen_server,_,_,_,Module|_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,_,Module|_]) -> +trans_init(gen,init_it,[GenMod,_,_,_,Module|_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; trans_init(gen,init_it,[gen_event|_]) -> {gen_event,init_it,6}; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 7f9bbbf649..dc17a44150 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, -- cgit v1.2.3 From 3815de0c7337058991066454c246587c0dbaa664 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 16 Feb 2016 10:51:39 +0100 Subject: Change to {next_state,...} and {stop,...} return format --- lib/stdlib/src/gen_statem.erl | 103 +++++++++++++++++++++++++++--------------- 1 file changed, 67 insertions(+), 36 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 9bb5ed013b..7c3cd8c2f3 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -74,14 +74,13 @@ {'retry', Retry :: boolean()} | 'hibernate' | % Hibernate the server instead of going into receive {'hibernate', Hibernate :: boolean()} | + (Timeout :: timeout()) | % {timeout,Timeout} {'timeout', % Generate a ('timeout', Msg, ...) event after Time Time :: timeout(), Msg :: term()}. -type state_operation() :: %% These can occur multiple times and are executed in order %% of appearence in the state_op() list - {'reply', % Reply to a client - Client :: client(), Reply :: term()} | - {'stop', Reason :: term()} | % Stop the server + reply_operation() | {'insert_event', % Insert event as the next to handle EventType :: event_type(), EventContent :: term()} | @@ -95,6 +94,9 @@ MonitorRef :: reference()} | {'unlink', % Unlink and clean up mess(ages) Id :: pid() | port()}. +-type reply_operation() :: + {'reply', % Reply to a client + Client :: client(), Reply :: term()}. %% The state machine init function. It is called only once and %% the server is not running until this function has returned @@ -122,12 +124,20 @@ PrevState :: state(), State :: state(), % Current state StateData :: state_data()) -> - [state_op()] | % {State,StateData,[state_op()]} - {} | % {State,StateData,[]} - {NewStateData :: state_data()} | % {State,NewStateData,[retry]} - {NewState :: state(), - NewStateData :: state_data()} | % {NewState,NewStateData,[]} - {NewState :: state(), NewStateData :: state_data(), [state_op()]}. + {stop, % Stop the server + Reason :: term(), + NewStateData :: state_data()} | + {stop, % Stop the server + Reason :: term(), + [reply_operation()] | reply_operation(), + NewStateData :: state_data()} | + {next_state, % {next_state,NewState,NewStateData,[]} + NewState :: state(), + NewStateData :: state_data()} | + {next_state, % State transition, maybe to the same state + NewState :: state(), + NewStateData :: state_data(), + [state_op()] | state_op()}. %% Clean up before the server terminates. -callback terminate( @@ -679,35 +689,42 @@ loop_events( terminate(Class, Reason, Stacktrace, Debug, S, Q) end. -%% Interprete all callback return value variants -loop_event_result( - Parent, Debug, - #{state := State, state_data := StateData} = S, - Events, Event, Result) -> +%% Interpret all callback return value variants +loop_event_result(Parent, Debug, S, Events, Event, Result) -> case Result of - {} -> % Ignore - loop_event_state_ops( - Parent, Debug, S, Events, Event, - State, StateData, []); - {NewStateData} -> % Retry - loop_event_state_ops( - Parent, Debug, S, Events, Event, - State, NewStateData, [retry]); - {NewState,NewStateData} -> % Consume + {stop,Reason,NewStateData} -> + terminate( + Reason, Debug, + S#{state_data := NewStateData}, + [Event|Events]); + {stop,Reason,Reply,NewStateData} -> + NewS = S#{state_data := NewStateData}, + Q = [Event|Events], + Replies = + if + is_list(Reply) -> + Reply; + true -> + [Reply] + end, + BadReplies = + reply_then_terminate(Reason, Debug, NewS, Q, Replies), + %% Since it returned Replies was bad + terminate( + {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, + Debug, NewS, Q); + {next_state,NewState,NewStateData} -> loop_event_state_ops( Parent, Debug, S, Events, Event, NewState, NewStateData, []); - {NewState,NewStateData,StateOps} when is_list(StateOps) -> + {next_state,NewState,NewStateData,StateOps} + when is_list(StateOps) -> loop_event_state_ops( Parent, Debug, S, Events, Event, NewState, NewStateData, StateOps); - StateOps when is_list(StateOps) -> % Stay in state - loop_event_state_ops( - Parent, Debug, S, Events, Event, - State, StateData, StateOps); - BadReturn -> + _ -> terminate( - {bad_return_value,BadReturn}, Debug, S, [Event|Events]) + {bad_return_value,Result}, Debug, S, [Event|Events]) end. loop_event_state_ops( @@ -750,7 +767,8 @@ loop_event_state_ops( %% Pretend the timeout has just been received {undefined,Q3 ++ [{timeout,Msg}]}; {timeout,Time,Msg} -> - {erlang:start_timer(Time, self(), Msg),Q3} + {erlang:start_timer(Time, self(), Msg), + Q3} end, loop_events( Parent, NewDebug, @@ -820,11 +838,8 @@ process_state_operations([], Debug, _S, Q, P) -> process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> case Operation of {reply,{_To,_Tag}=Client,Reply} -> - reply(Client, Reply), - NewDebug = sys_debug(Debug, S, {out,Reply,Client}), + NewDebug = do_reply(Debug, S, Client, Reply), process_state_operations(Operations, NewDebug, S, Q, P); - {stop,Reason} -> - [Reason,Debug]; {insert_event,Type,Content} -> case event_type(Type) of true -> @@ -854,6 +869,22 @@ process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> end end. +reply_then_terminate(Reason, Debug, S, Q, []) -> + terminate(Reason, Debug, S, Q); +reply_then_terminate(Reason, Debug, S, Q, [R|Rs] = RRs) -> + case R of + {reply,{_To,_Tag}=Client,Reply} -> + NewDebug = do_reply(Debug, S, Client, Reply), + reply_then_terminate(Reason, NewDebug, S, Q, Rs); + _ -> + RRs % bad_return_value + end. + +do_reply(Debug, S, Client, Reply) -> + reply(Client, Reply), + sys_debug(Debug, S, {out,Reply,Client}). + + %% Remove oldest matching event from the queue(s) remove_event(RemoveFun, Q, P) -> try @@ -928,7 +959,7 @@ remove_fun({unlink,Id}) -> end catch Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} + [Class,Reason,erlang:get_stacktrace()] end; remove_fun(_) -> undefined. -- cgit v1.2.3 From 99d48f5921f95073c8e46280494746b0e1a2c375 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 16 Feb 2016 17:54:15 +0100 Subject: Implement option callback_mode --- lib/stdlib/src/gen_statem.erl | 134 +++++++++++++++++++++++++++++------------- 1 file changed, 93 insertions(+), 41 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7c3cd8c2f3..e6bb38fc2c 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -44,6 +44,9 @@ -export( [wakeup_from_hibernate/3]). +%% Fix problem for doc build +-export_type([state_callback_result/0]). + %%%========================================================================== %%% Interface functions. %%%========================================================================== @@ -51,14 +54,18 @@ -type client() :: {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: - atom() | % Calls state callback function State/5 - term(). % Calls state callback function handle_event/5 + state_name() | % For state callback function StateName/5 + term(). % For state callback function handle_event/5 +-type state_name() :: atom(). -type state_data() :: term(). -type event_type() :: {'call',Client :: client()} | 'cast' | 'info' | 'timeout' | 'internal'. -type event_predicate() :: % Return true for the event in question fun((event_type(), term()) -> boolean()). +-type init_option() :: + {'callback_mode', callback_mode()}. +-type callback_mode() :: 'state_functions' | 'handle_event_function'. -type state_op() :: %% First NewState and NewStateData are set, %% then all state_operations() are executed in order of @@ -97,6 +104,21 @@ -type reply_operation() :: {'reply', % Reply to a client Client :: client(), Reply :: term()}. +-type state_callback_result() :: + {stop, % Stop the server + Reason :: term(), + NewStateData :: state_data()} | + {stop, % Stop the server + Reason :: term(), + Replies :: [reply_operation()] | reply_operation(), + NewStateData :: state_data()} | + {next_state, % {next_state,NewState,NewStateData,[]} + NewState :: state(), + NewStateData :: state_data()} | + {next_state, % State transition, maybe to the same state + NewState :: state(), + NewStateData :: state_data(), + StateOps :: [state_op()] | state_op()}. %% The state machine init function. It is called only once and %% the server is not running until this function has returned @@ -104,40 +126,36 @@ %% for all events to this server. -callback init(Args :: term()) -> {'ok', state(), state_data()} | - {'ok', state(), state_data(), [state_op()]} | + {'ok', state(), state_data(), [state_op()|init_option()]} | 'ignore' | {'stop', Reason :: term()}. -%% An example callback for a fictive state 'handle_event' -%% that you should avoid having. See below. +%% Example callback for callback_mode =:= state_functions +%% state name 'state_name'. +%% +%% In this mode all states has to be type state_name() i.e atom(). %% %% Note that state callbacks and only state callbacks have arity 5 %% and that is intended. +-callback state_name( + event_type(), + EventContent :: term(), + PrevStateName :: state_name() | reference(), + StateName :: state_name(), % Current state + StateData :: state_data()) -> + state_callback_result(). +%% +%% Callback for callback_mode =:= handle_event_function. %% -%% You should not actually use 'handle_event' as a state name, -%% since it is the callback function that is used if you would use -%% a State that is not an atom(). This is because since there is -%% no obvious way to decide on a state function name from any term(). +%% Note that state callbacks and only state callbacks have arity 5 +%% and that is intended. -callback handle_event( event_type(), EventContent :: term(), PrevState :: state(), State :: state(), % Current state StateData :: state_data()) -> - {stop, % Stop the server - Reason :: term(), - NewStateData :: state_data()} | - {stop, % Stop the server - Reason :: term(), - [reply_operation()] | reply_operation(), - NewStateData :: state_data()} | - {next_state, % {next_state,NewState,NewStateData,[]} - NewState :: state(), - NewStateData :: state_data()} | - {next_state, % State transition, maybe to the same state - NewState :: state(), - NewStateData :: state_data(), - [state_op()] | state_op()}. + state_callback_result(). %% Clean up before the server terminates. -callback terminate( @@ -171,8 +189,11 @@ -optional_callbacks( [format_status/2, % Has got a default implementation - handle_event/5]). % Only needed for State not an atom() -%% For every atom() State there has to be a State/5 callback function + %% + state_name/5, % Example for callback_mode =:= state_functions: + %% there has to be a StateName/5 callback function for every StateName. + %% + handle_event/5]). % For callback_mode =:= handle_event_function %% Type validation functions client({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> @@ -366,7 +387,8 @@ enter_loop(Module, Options, State, StateData) -> -spec enter_loop( Module :: module(), Options :: [debug_opt()], State :: state(), StateData :: state_data(), - Server_or_StateOps :: server_name() | pid() | [state_op()]) -> + Server_or_StateOps :: + server_name() | pid() | [state_op()|init_option()]) -> no_return(). enter_loop(Module, Options, State, StateData, Server_or_StateOps) -> if @@ -384,7 +406,7 @@ enter_loop(Module, Options, State, StateData, Server_or_StateOps) -> Module :: module(), Options :: [debug_opt()], State :: state(), StateData :: state_data(), Server :: server_name() | pid(), - StateOps :: [state_op()]) -> + StateOps :: [state_op()|init_option()]) -> no_return(). enter_loop(Module, Options, State, StateData, Server, StateOps) -> Parent = gen:get_parent(), @@ -410,11 +432,12 @@ do_send(Proc, Msg) -> end. %% Here init_it and all enter_loop functions converge -enter(Module, Options, State, StateData, Server, StateOps, Parent) -> +enter(Module, Options, State, StateData, Server, InitOps, Parent) -> Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Options), PrevState = make_ref(), S = #{ + callback_mode => state_functions, module => Module, name => Name, prev_state => PrevState, @@ -423,9 +446,17 @@ enter(Module, Options, State, StateData, Server, StateOps, Parent) -> timer => undefined, postponed => [], hibernate => false}, - loop_event_state_ops( - Parent, Debug, S, [], {event,undefined}, - State, StateData, [{retry,false}|StateOps]). + case collect_init_options(InitOps) of + {CallbackMode,StateOps} -> + loop_event_state_ops( + Parent, Debug, + S#{callback_mode := CallbackMode}, + [], {event,undefined}, + State, StateData, + [{retry,false}|StateOps]); + [Reason] -> + terminate(Reason, Debug, S, []) + end. %%%========================================================================== %%% gen callbacks @@ -643,13 +674,13 @@ loop_receive(Parent, Debug, S, Event, Timer) -> %% The loop_event* functions optimize S map handling by dismantling it, %% passing the parts in arguments to avoid map lookups and construct the %% new S map in one go on exit. Premature optimization, I know, but -%% the code was way to readable and there were quite some map lookups -%% repeated in different functions. +%% there were quite some map lookups repeated in different functions. loop_events(Parent, Debug, S, [], _Timer) -> loop(Parent, Debug, S); loop_events( Parent, Debug, - #{module := Module, + #{callback_mode := CallbackMode, + module := Module, prev_state := PrevState, state := State, state_data := StateData} = S, @@ -657,11 +688,11 @@ loop_events( _ = (Timer =/= undefined) andalso cancel_timer(Timer), Func = - if - is_atom(State) -> - State; - true -> - handle_event + case CallbackMode of + handle_event_function -> + handle_event; + state_functions -> + State end, try Module:Func(Type, Content, PrevState, State, StateData) of Result -> @@ -675,7 +706,10 @@ loop_events( %% Process an undef to check for the simple mistake %% of calling a nonexistent state function case erlang:get_stacktrace() of - [{Module,State,[Event,StateData]=Args,_}|Stacktrace] -> + [{Module,Func, + [Type,Content,PrevState,State,StateData]=Args, + _} + |Stacktrace] -> terminate( error, {undef_state_function,{Module,State,Args}}, @@ -709,7 +743,7 @@ loop_event_result(Parent, Debug, S, Events, Event, Result) -> end, BadReplies = reply_then_terminate(Reason, Debug, NewS, Q, Replies), - %% Since it returned Replies was bad + %% Since we got back here Replies was bad terminate( {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, Debug, NewS, Q); @@ -794,6 +828,24 @@ loop_event_state_ops( %%--------------------------------------------------------------------------- %% Server helpers +collect_init_options(InitOps) -> + collect_init_options(lists:reverse(InitOps), state_functions, []). +%% Keep the last of each kind +collect_init_options([], CallbackMode, StateOps) -> + {CallbackMode,StateOps}; +collect_init_options([InitOp|InitOps] = IOIOs, CallbackMode, StateOps) -> + case InitOp of + {callback_mode,Mode} + when Mode =:= state_functions; + Mode =:= handle_event_function -> + collect_init_options(InitOps, Mode, StateOps); + {callback_mode,_} -> + [{bad_init_ops,IOIOs}]; + _ -> % Collect others as StateOps + collect_init_options( + InitOps, CallbackMode, [InitOp|StateOps]) + end. + collect_state_options(StateOps) -> collect_state_options( lists:reverse(StateOps), false, false, undefined, []). -- cgit v1.2.3 From b0357eba067295b61fac0128344d8c49a07254cf Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 17 Feb 2016 17:38:36 +0100 Subject: Clean up error report printouts --- lib/stdlib/src/gen_statem.erl | 76 ++++++++++++++++++++++++++++++------------- 1 file changed, 53 insertions(+), 23 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index e6bb38fc2c..782e027b29 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -217,6 +217,22 @@ event_type(Type) -> false end. + + +-define( + STACKTRACE(), + try throw(ok) catch _ -> erlang:get_stacktrace() end). + +-define( + TERMINATE(Reason, Debug, S, Q), + terminate( + exit, + begin Reason end, + ?STACKTRACE(), + begin Debug end, + begin S end, + begin Q end)). + %%%========================================================================== %%% API @@ -455,7 +471,7 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> State, StateData, [{retry,false}|StateOps]); [Reason] -> - terminate(Reason, Debug, S, []) + ?TERMINATE(Reason, Debug, S, []) end. %%%========================================================================== @@ -510,7 +526,7 @@ system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). system_terminate(Reason, _Parent, Debug, S) -> - terminate(Reason, Debug, S, []). + ?TERMINATE(Reason, Debug, S, []). system_code_change( #{module := Module, @@ -646,7 +662,7 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... - terminate(Reason, Debug, S, [EXIT]); + ?TERMINATE(Reason, Debug, S, [EXIT]); {timeout,Timer,Content} when Timer =/= undefined -> loop_receive( Parent, Debug, S, {timeout,Content}, undefined); @@ -727,7 +743,7 @@ loop_events( loop_event_result(Parent, Debug, S, Events, Event, Result) -> case Result of {stop,Reason,NewStateData} -> - terminate( + ?TERMINATE( Reason, Debug, S#{state_data := NewStateData}, [Event|Events]); @@ -742,9 +758,10 @@ loop_event_result(Parent, Debug, S, Events, Event, Result) -> [Reply] end, BadReplies = - reply_then_terminate(Reason, Debug, NewS, Q, Replies), + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad - terminate( + ?TERMINATE( {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, Debug, NewS, Q); {next_state,NewState,NewStateData} -> @@ -757,7 +774,7 @@ loop_event_result(Parent, Debug, S, Events, Event, Result) -> Parent, Debug, S, Events, Event, NewState, NewStateData, StateOps); _ -> - terminate( + ?TERMINATE( {bad_return_value,Result}, Debug, S, [Event|Events]) end. @@ -815,14 +832,14 @@ loop_event_state_ops( postponed := P}, Q, Timer); [Reason,Debug] -> - terminate(Reason, Debug, S, [Event|Events]); + ?TERMINATE(Reason, Debug, S, [Event|Events]); [Class,Reason,Stacktrace,Debug] -> terminate( Class, Reason, Stacktrace, Debug, S, [Event|Events]) end; %% [Reason] -> - terminate(Reason, Debug0, S, [Event|Events]) + ?TERMINATE(Reason, Debug0, S, [Event|Events]) end. %%--------------------------------------------------------------------------- @@ -921,13 +938,15 @@ process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> end end. -reply_then_terminate(Reason, Debug, S, Q, []) -> - terminate(Reason, Debug, S, Q); -reply_then_terminate(Reason, Debug, S, Q, [R|Rs] = RRs) -> +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); +reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs] = RRs) -> case R of {reply,{_To,_Tag}=Client,Reply} -> NewDebug = do_reply(Debug, S, Client, Reply), - reply_then_terminate(Reason, NewDebug, S, Q, Rs); + reply_then_terminate( + Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> RRs % bad_return_value end. @@ -1034,12 +1053,9 @@ cancel_timer(TimerRef) -> end. -terminate(Reason, Debug, S, Q) -> - terminate(exit, Reason, [], Debug, S, Q). -%% terminate( Class, Reason, Stacktrace, Debug, - #{name := Name, module := Module, + #{module := Module, state := State, state_data := StateData} = S, Q) -> try Module:terminate(Reason, State, StateData) of @@ -1049,7 +1065,7 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, Debug, Name, Q, + C, R, ST, Debug, S, Q, format_status(terminate, get(), S)), erlang:raise(C, R, ST) end, @@ -1059,7 +1075,7 @@ terminate( {shutdown,_} -> ok; _ -> error_info( - Class, Reason, Stacktrace, Debug, Name, Q, + Class, Reason, Stacktrace, Debug, S, Q, format_status(terminate, get(), S)) end, case Stacktrace of @@ -1070,7 +1086,10 @@ terminate( end. error_info( - Class, Reason, Stacktrace, Debug, Name, Q, FmtStateData) -> + Class, Reason, Stacktrace, Debug, + #{name := Name, callback_mode := CallbackMode, + state := State, postponed := P}, + Q, FmtStateData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1079,7 +1098,13 @@ error_info( false -> {{'module could not be loaded',M},ST}; _ -> - Arity = length(Args), + Arity = + if + is_list(Args) -> + length(Args); + is_integer(Args) -> + Args + end, case erlang:function_exported(M, F, Arity) of true -> {Reason,Stacktrace}; @@ -1100,6 +1125,9 @@ error_info( end ++ "** When Server state = ~p~n" ++ "** Reason for termination = ~w:~p~n" ++ + "** State = ~p~n" ++ + "** Callback mode = ~p~n" ++ + "** Queued/Posponed = ~w/~w~n" ++ case FixedStacktrace of [] -> ""; @@ -1110,10 +1138,12 @@ error_info( [Name | case Q of [] -> - [FmtStateData,Class,FixedReason]; + []; [Event|_] -> - [Event,FmtStateData,Class,FixedReason] + [Event] end] ++ + [FmtStateData,Class,FixedReason, + State,CallbackMode,length(Q),length(P)] ++ case FixedStacktrace of [] -> []; -- cgit v1.2.3 From 972a8fcb57a64c9a0dc7587e9072c15758e36da2 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 18 Feb 2016 10:22:50 +0100 Subject: Rename insert_event -> next_event --- lib/stdlib/src/gen_statem.erl | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 782e027b29..52fde7df7b 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -88,7 +88,7 @@ %% These can occur multiple times and are executed in order %% of appearence in the state_op() list reply_operation() | - {'insert_event', % Insert event as the next to handle + {'next_event', % Insert event as the next to handle EventType :: event_type(), EventContent :: term()} | {'remove_event', % Remove the oldest matching (=:=) event @@ -469,7 +469,7 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> S#{callback_mode := CallbackMode}, [], {event,undefined}, State, StateData, - [{retry,false}|StateOps]); + StateOps++[{retry,false}]); [Reason] -> ?TERMINATE(Reason, Debug, S, []) end. @@ -846,10 +846,10 @@ loop_event_state_ops( %% Server helpers collect_init_options(InitOps) -> - collect_init_options(lists:reverse(InitOps), state_functions, []). + collect_init_options(InitOps, state_functions, []). %% Keep the last of each kind collect_init_options([], CallbackMode, StateOps) -> - {CallbackMode,StateOps}; + {CallbackMode,lists:reverse(StateOps)}; collect_init_options([InitOp|InitOps] = IOIOs, CallbackMode, StateOps) -> case InitOp of {callback_mode,Mode} @@ -864,12 +864,11 @@ collect_init_options([InitOp|InitOps] = IOIOs, CallbackMode, StateOps) -> end. collect_state_options(StateOps) -> - collect_state_options( - lists:reverse(StateOps), false, false, undefined, []). + collect_state_options(StateOps, false, false, undefined, []). %% Keep the last of each kind collect_state_options( [], Retry, Hibernate, Timeout, Operations) -> - {Retry,Hibernate,Timeout,Operations}; + {Retry,Hibernate,Timeout,lists:reverse(Operations)}; collect_state_options( [StateOp|StateOps] = SOSOs, Retry, Hibernate, Timeout, Operations) -> case StateOp of @@ -909,7 +908,7 @@ process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> {reply,{_To,_Tag}=Client,Reply} -> NewDebug = do_reply(Debug, S, Client, Reply), process_state_operations(Operations, NewDebug, S, Q, P); - {insert_event,Type,Content} -> + {next_event,Type,Content} -> case event_type(Type) of true -> process_state_operations( -- cgit v1.2.3 From fdd72bc94149c7e279b5c4fd5a040af1886a4c72 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 18 Feb 2016 11:17:42 +0100 Subject: Rename retry -> postpone --- lib/stdlib/src/gen_statem.erl | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 52fde7df7b..32174687cf 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -70,15 +70,15 @@ %% First NewState and NewStateData are set, %% then all state_operations() are executed in order of %% apperance. Postponing the current event is performed - %% (iff state_option() 'retry' is 'true'). + %% (iff state_option() 'postpone' is 'true'). %% Lastly pending events are processed or if there are %% no pending events the server goes into receive %% or hibernate (iff state_option() 'hibernate' is 'true') state_option() | state_operation(). -type state_option() :: %% The first of each kind in the state_op() list takes precedence - 'retry' | % Postpone the current event to a different (=/=) state - {'retry', Retry :: boolean()} | + 'postpone' | % Postpone the current event to a different (=/=) state + {'postpone', Postpone :: boolean()} | 'hibernate' | % Hibernate the server instead of going into receive {'hibernate', Hibernate :: boolean()} | (Timeout :: timeout()) | % {timeout,Timeout} @@ -469,7 +469,7 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> S#{callback_mode := CallbackMode}, [], {event,undefined}, State, StateData, - StateOps++[{retry,false}]); + StateOps++[{postpone,false}]); [Reason] -> ?TERMINATE(Reason, Debug, S, []) end. @@ -782,9 +782,9 @@ loop_event_state_ops( Parent, Debug0, #{state := State, postponed := P0} = S, Events, Event, NewState, NewStateData, StateOps) -> case collect_state_options(StateOps) of - {Retry,Hibernate,Timeout,Operations} -> - P1 = % Move current event to postponed if Retry - case Retry of + {Postpone,Hibernate,Timeout,Operations} -> + P1 = % Move current event to postponed if Postpone + case Postpone of true -> [Event|P0]; false -> @@ -804,9 +804,9 @@ loop_event_state_ops( NewDebug = sys_debug( Debug, S, - case Retry of + case Postpone of true -> - {retry,Event,NewState}; + {postpone,Event,NewState}; false -> {consume,Event,NewState} end), @@ -867,38 +867,38 @@ collect_state_options(StateOps) -> collect_state_options(StateOps, false, false, undefined, []). %% Keep the last of each kind collect_state_options( - [], Retry, Hibernate, Timeout, Operations) -> - {Retry,Hibernate,Timeout,lists:reverse(Operations)}; + [], Postpone, Hibernate, Timeout, Operations) -> + {Postpone,Hibernate,Timeout,lists:reverse(Operations)}; collect_state_options( - [StateOp|StateOps] = SOSOs, Retry, Hibernate, Timeout, Operations) -> + [StateOp|StateOps] = SOSOs, Postpone, Hibernate, Timeout, Operations) -> case StateOp of - retry -> + postpone -> collect_state_options( StateOps, true, Hibernate, Timeout, Operations); - {retry,NewRetry} when is_boolean(NewRetry) -> + {postpone,NewPostpone} when is_boolean(NewPostpone) -> collect_state_options( - StateOps, NewRetry, Hibernate, Timeout, Operations); - {retry,_} -> + StateOps, NewPostpone, Hibernate, Timeout, Operations); + {postpone,_} -> [{bad_state_ops,SOSOs}]; hibernate -> collect_state_options( - StateOps, Retry, true, Timeout, Operations); + StateOps, Postpone, true, Timeout, Operations); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> collect_state_options( - StateOps, Retry, NewHibernate, Timeout, Operations); + StateOps, Postpone, NewHibernate, Timeout, Operations); {hibernate,_} -> [{bad_state_ops,SOSOs}]; {timeout,infinity,_} -> % Ignore since it will never time out collect_state_options( - StateOps, Retry, Hibernate, undefined, Operations); + StateOps, Postpone, Hibernate, undefined, Operations); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> collect_state_options( - StateOps, Retry, Hibernate, NewTimeout, Operations); + StateOps, Postpone, Hibernate, NewTimeout, Operations); {timeout,_,_} -> [{bad_state_ops,SOSOs}]; _ -> % Collect others as operations collect_state_options( - StateOps, Retry, Hibernate, Timeout, [StateOp|Operations]) + StateOps, Postpone, Hibernate, Timeout, [StateOp|Operations]) end. process_state_operations([], Debug, _S, Q, P) -> -- cgit v1.2.3 From 82f34a7a9de85b4afc0dac4c9c426939264c5039 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 18 Feb 2016 16:06:57 +0100 Subject: Write some convenience helpers --- lib/stdlib/src/gen_statem.erl | 39 ++++++++++++++++++++++++++++++++------- 1 file changed, 32 insertions(+), 7 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 32174687cf..486f61b1ed 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -25,7 +25,7 @@ stop/1,stop/3, cast/2,call/2,call/3, enter_loop/4,enter_loop/5,enter_loop/6, - reply/2]). + reply/1,reply/2]). %% gen callbacks -export( @@ -105,17 +105,21 @@ {'reply', % Reply to a client Client :: client(), Reply :: term()}. -type state_callback_result() :: - {stop, % Stop the server + {'stop', % Stop the server + Reason :: term()} | + {'stop', % Stop the server Reason :: term(), NewStateData :: state_data()} | - {stop, % Stop the server + {'stop', % Stop the server Reason :: term(), Replies :: [reply_operation()] | reply_operation(), NewStateData :: state_data()} | - {next_state, % {next_state,NewState,NewStateData,[]} + {'next_state', % {next_state,State,StateData,StateOps} % Actually useful + StateOps :: [state_op()] | state_op()} | + {'next_state', % {next_state,NewState,NewStateData,[]} NewState :: state(), NewStateData :: state_data()} | - {next_state, % State transition, maybe to the same state + {'next_state', % State transition, maybe to the same state NewState :: state(), NewStateData :: state_data(), StateOps :: [state_op()] | state_op()}. @@ -379,6 +383,10 @@ call(ServerRef, Request, Timeout) -> end. %% Reply from a state machine callback to whom awaits in call/2 +-spec reply(ReplyOperation :: reply_operation()) -> ok. +reply({reply,{_To,_Tag}=Client,Reply}) -> + reply(Client, Reply). +%% -spec reply(Client :: client(), Reply :: term()) -> ok. reply({To,Tag}, Reply) -> Msg = {Tag,Reply}, @@ -742,6 +750,8 @@ loop_events( %% Interpret all callback return value variants loop_event_result(Parent, Debug, S, Events, Event, Result) -> case Result of + {stop,Reason} -> + ?TERMINATE(Reason, Debug, S, [Event|Events]); {stop,Reason,NewStateData} -> ?TERMINATE( Reason, Debug, @@ -764,6 +774,11 @@ loop_event_result(Parent, Debug, S, Events, Event, Result) -> ?TERMINATE( {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, Debug, NewS, Q); + {next_state,StateOps} -> + #{state := State, state_data := StateData} = S, + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, StateData, StateOps); {next_state,NewState,NewStateData} -> loop_event_state_ops( Parent, Debug, S, Events, Event, @@ -846,7 +861,12 @@ loop_event_state_ops( %% Server helpers collect_init_options(InitOps) -> - collect_init_options(InitOps, state_functions, []). + if + is_list(InitOps) -> + collect_init_options(InitOps, state_functions, []); + true -> + collect_init_options([InitOps], state_functions, []) + end. %% Keep the last of each kind collect_init_options([], CallbackMode, StateOps) -> {CallbackMode,lists:reverse(StateOps)}; @@ -864,7 +884,12 @@ collect_init_options([InitOp|InitOps] = IOIOs, CallbackMode, StateOps) -> end. collect_state_options(StateOps) -> - collect_state_options(StateOps, false, false, undefined, []). + if + is_list(StateOps) -> + collect_state_options(StateOps, false, false, undefined, []); + true -> + collect_state_options([StateOps], false, false, undefined, []) + end. %% Keep the last of each kind collect_state_options( [], Postpone, Hibernate, Timeout, Operations) -> -- cgit v1.2.3 From 26a7af61fbffae90c0968d945ae8b146582ba068 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 18 Feb 2016 16:38:57 +0100 Subject: Change initial PrevState to 'undefined' --- lib/stdlib/src/gen_statem.erl | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 486f61b1ed..e03e22b087 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -459,13 +459,13 @@ do_send(Proc, Msg) -> enter(Module, Options, State, StateData, Server, InitOps, Parent) -> Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Options), - PrevState = make_ref(), + PrevState = undefined, S = #{ callback_mode => state_functions, module => Module, name => Name, prev_state => PrevState, - state => PrevState, + state => PrevState, % Will be discarded by loop_event_state_ops state_data => StateData, timer => undefined, postponed => [], @@ -475,7 +475,8 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> loop_event_state_ops( Parent, Debug, S#{callback_mode := CallbackMode}, - [], {event,undefined}, + [], + {event,undefined}, % Will be discarded by {postpone,false} State, StateData, StateOps++[{postpone,false}]); [Reason] -> -- cgit v1.2.3 From 65767cfc36cf8658b45d68b3c17d4bd612198165 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 19 Feb 2016 09:22:52 +0100 Subject: Add {keep_state,...} and {keep_state_and_data,...} --- lib/stdlib/src/gen_statem.erl | 46 +++++++++++++++++++++++++++++++------------ 1 file changed, 33 insertions(+), 13 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index e03e22b087..3da4443f13 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -114,14 +114,20 @@ Reason :: term(), Replies :: [reply_operation()] | reply_operation(), NewStateData :: state_data()} | - {'next_state', % {next_state,State,StateData,StateOps} % Actually useful - StateOps :: [state_op()] | state_op()} | {'next_state', % {next_state,NewState,NewStateData,[]} NewState :: state(), NewStateData :: state_data()} | {'next_state', % State transition, maybe to the same state NewState :: state(), NewStateData :: state_data(), + StateOps :: [state_op()] | state_op()} | + {'keep_state', % {keep_state,NewStateData,[]} + NewStateData :: state_data()} | + {'keep_state', + NewStateData :: state_data(), + StateOps :: [state_op()] | state_op()} | + {'keep_state_and_data'} | % {keep_state_and_data,[]} + {'keep_state_and_data', StateOps :: [state_op()] | state_op()}. %% The state machine init function. It is called only once and @@ -477,7 +483,7 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> S#{callback_mode := CallbackMode}, [], {event,undefined}, % Will be discarded by {postpone,false} - State, StateData, + PrevState, State, StateData, StateOps++[{postpone,false}]); [Reason] -> ?TERMINATE(Reason, Debug, S, []) @@ -749,7 +755,10 @@ loop_events( end. %% Interpret all callback return value variants -loop_event_result(Parent, Debug, S, Events, Event, Result) -> +loop_event_result( + Parent, Debug, + #{state := State, state_data := StateData} = S, + Events, Event, Result) -> case Result of {stop,Reason} -> ?TERMINATE(Reason, Debug, S, [Event|Events]); @@ -775,28 +784,39 @@ loop_event_result(Parent, Debug, S, Events, Event, Result) -> ?TERMINATE( {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, Debug, NewS, Q); - {next_state,StateOps} -> - #{state := State, state_data := StateData} = S, - loop_event_state_ops( - Parent, Debug, S, Events, Event, - State, StateData, StateOps); {next_state,NewState,NewStateData} -> loop_event_state_ops( Parent, Debug, S, Events, Event, - NewState, NewStateData, []); + State, NewState, NewStateData, []); {next_state,NewState,NewStateData,StateOps} when is_list(StateOps) -> loop_event_state_ops( Parent, Debug, S, Events, Event, - NewState, NewStateData, StateOps); + State, NewState, NewStateData, StateOps); + {keep_state,NewStateData} -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, State, NewStateData, []); + {keep_state,NewStateData,StateOps} -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, State, NewStateData, StateOps); + {keep_state_and_data} -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, State, StateData, []); + {keep_state_and_data,StateOps} -> + loop_event_state_ops( + Parent, Debug, S, Events, Event, + State, State, StateData, StateOps); _ -> ?TERMINATE( {bad_return_value,Result}, Debug, S, [Event|Events]) end. loop_event_state_ops( - Parent, Debug0, #{state := State, postponed := P0} = S, Events, Event, - NewState, NewStateData, StateOps) -> + Parent, Debug0, #{postponed := P0} = S, Events, Event, + State, NewState, NewStateData, StateOps) -> case collect_state_options(StateOps) of {Postpone,Hibernate,Timeout,Operations} -> P1 = % Move current event to postponed if Postpone -- cgit v1.2.3 From fc1e649e3613f18dec8514921d0439ddcca73bdb Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 19 Feb 2016 09:39:46 +0100 Subject: Add reply([Reply]) --- lib/stdlib/src/gen_statem.erl | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 3da4443f13..8aa8afd091 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -389,9 +389,12 @@ call(ServerRef, Request, Timeout) -> end. %% Reply from a state machine callback to whom awaits in call/2 --spec reply(ReplyOperation :: reply_operation()) -> ok. +-spec reply([reply_operation()] | reply_operation()) -> ok. reply({reply,{_To,_Tag}=Client,Reply}) -> - reply(Client, Reply). + reply(Client, Reply); +reply(Replies) when is_list(Replies) -> + [reply(Reply) || Reply <- Replies], + ok. %% -spec reply(Client :: client(), Reply :: term()) -> ok. reply({To,Tag}, Reply) -> -- cgit v1.2.3 From 898e66f07dce8b7b33874255bb3ea1c6f5534d34 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 19 Feb 2016 15:26:33 +0100 Subject: Update terminology to data(), transition_op(), etc --- lib/stdlib/src/gen_statem.erl | 382 +++++++++++++++++++++--------------------- 1 file changed, 192 insertions(+), 190 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 8aa8afd091..1ca2e1009c 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -57,7 +57,7 @@ state_name() | % For state callback function StateName/5 term(). % For state callback function handle_event/5 -type state_name() :: atom(). --type state_data() :: term(). +-type data() :: term(). -type event_type() :: {'call',Client :: client()} | 'cast' | 'info' | 'timeout' | 'internal'. @@ -66,17 +66,18 @@ -type init_option() :: {'callback_mode', callback_mode()}. -type callback_mode() :: 'state_functions' | 'handle_event_function'. --type state_op() :: - %% First NewState and NewStateData are set, - %% then all state_operations() are executed in order of +-type transition_op() :: + %% First NewState and NewData are set, + %% then all transition_action()s are executed in order of %% apperance. Postponing the current event is performed - %% (iff state_option() 'postpone' is 'true'). + %% (iff transition_option() 'postpone' is 'true'). %% Lastly pending events are processed or if there are %% no pending events the server goes into receive - %% or hibernate (iff state_option() 'hibernate' is 'true') - state_option() | state_operation(). --type state_option() :: - %% The first of each kind in the state_op() list takes precedence + %% or hibernate (iff transition_option() 'hibernate' is 'true') + transition_option() | transition_action(). +-type transition_option() :: + %% The last of each kind in the transition_op() + %% list takes precedence 'postpone' | % Postpone the current event to a different (=/=) state {'postpone', Postpone :: boolean()} | 'hibernate' | % Hibernate the server instead of going into receive @@ -84,10 +85,10 @@ (Timeout :: timeout()) | % {timeout,Timeout} {'timeout', % Generate a ('timeout', Msg, ...) event after Time Time :: timeout(), Msg :: term()}. --type state_operation() :: +-type transition_action() :: %% These can occur multiple times and are executed in order - %% of appearence in the state_op() list - reply_operation() | + %% of appearence in the transition_op() list + reply_action() | {'next_event', % Insert event as the next to handle EventType :: event_type(), EventContent :: term()} | @@ -101,7 +102,7 @@ MonitorRef :: reference()} | {'unlink', % Unlink and clean up mess(ages) Id :: pid() | port()}. --type reply_operation() :: +-type reply_action() :: {'reply', % Reply to a client Client :: client(), Reply :: term()}. -type state_callback_result() :: @@ -109,34 +110,34 @@ Reason :: term()} | {'stop', % Stop the server Reason :: term(), - NewStateData :: state_data()} | + NewData :: data()} | {'stop', % Stop the server Reason :: term(), - Replies :: [reply_operation()] | reply_operation(), - NewStateData :: state_data()} | - {'next_state', % {next_state,NewState,NewStateData,[]} + Replies :: [reply_action()] | reply_action(), + NewData :: data()} | + {'next_state', % {next_state,NewState,NewData,[]} NewState :: state(), - NewStateData :: state_data()} | + NewData :: data()} | {'next_state', % State transition, maybe to the same state NewState :: state(), - NewStateData :: state_data(), - StateOps :: [state_op()] | state_op()} | - {'keep_state', % {keep_state,NewStateData,[]} - NewStateData :: state_data()} | + NewData :: data(), + Ops :: [transition_op()] | transition_op()} | + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | {'keep_state', - NewStateData :: state_data(), - StateOps :: [state_op()] | state_op()} | + NewData :: data(), + Ops :: [transition_op()] | transition_op()} | {'keep_state_and_data'} | % {keep_state_and_data,[]} {'keep_state_and_data', - StateOps :: [state_op()] | state_op()}. + Ops :: [transition_op()] | transition_op()}. %% The state machine init function. It is called only once and %% the server is not running until this function has returned %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. -callback init(Args :: term()) -> - {'ok', state(), state_data()} | - {'ok', state(), state_data(), [state_op()|init_option()]} | + {'ok', state(), data()} | + {'ok', state(), data(), [transition_op()|init_option()]} | 'ignore' | {'stop', Reason :: term()}. @@ -152,7 +153,7 @@ EventContent :: term(), PrevStateName :: state_name() | reference(), StateName :: state_name(), % Current state - StateData :: state_data()) -> + Data :: data()) -> state_callback_result(). %% %% Callback for callback_mode =:= handle_event_function. @@ -164,7 +165,7 @@ EventContent :: term(), PrevState :: state(), State :: state(), % Current state - StateData :: state_data()) -> + Data :: data()) -> state_callback_result(). %% Clean up before the server terminates. @@ -172,7 +173,7 @@ Reason :: 'normal' | 'shutdown' | {'shutdown', term()} | term(), State :: state(), - StateData :: state_data()) -> + Data :: data()) -> any(). %% Note that the new code can expect to get an OldState from @@ -181,9 +182,9 @@ -callback code_change( OldVsn :: term() | {'down', term()}, OldState :: state(), - OldStateData :: state_data(), + OldData :: data(), Extra :: term()) -> - {ok, {NewState :: state(), NewStateData :: state_data()}}. + {ok, {NewState :: state(), NewData :: data()}}. %% Format the callback module state in some sensible that is %% often condensed way. For StatusOption =:= 'normal' the perferred @@ -193,7 +194,7 @@ StatusOption, [ [{Key :: term(), Value :: term()}] | state() | - state_data()]) -> + data()]) -> Status :: term() when StatusOption :: 'normal' | 'terminate'. @@ -264,38 +265,38 @@ event_type(Type) -> -type start_opt() :: debug_opt() | {'timeout', Time :: timeout()} - | {'spawn_opt', SOpts :: [proc_lib:spawn_option()]}. + | {'spawn_opt', [proc_lib:spawn_option()]}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. %% Start a state machine -spec start( - Module :: module(), Args :: term(), Options :: [start_opt()]) -> + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> start_ret(). -start(Module, Args, Options) -> - gen:start(?MODULE, nolink, Module, Args, Options). +start(Module, Args, Opts) -> + gen:start(?MODULE, nolink, Module, Args, Opts). %% -spec start( ServerName :: server_name(), - Module :: module(), Args :: term(), Options :: [start_opt()]) -> + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> start_ret(). -start(ServerName, Module, Args, Options) -> - gen:start(?MODULE, nolink, ServerName, Module, Args, Options). +start(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Opts). %% Start and link to a state machine -spec start_link( - Module :: module(), Args :: term(), Options :: [start_opt()]) -> + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> start_ret(). -start_link(Module, Args, Options) -> - gen:start(?MODULE, link, Module, Args, Options). +start_link(Module, Args, Opts) -> + gen:start(?MODULE, link, Module, Args, Opts). %% -spec start_link( ServerName :: server_name(), - Module :: module(), Args :: term(), Options :: [start_opt()]) -> + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> start_ret(). -start_link(ServerName, Module, Args, Options) -> - gen:start(?MODULE, link, ServerName, Module, Args, Options). +start_link(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, link, ServerName, Module, Args, Opts). %% Stop a state machine -spec stop(ServerRef :: server_ref()) -> ok. @@ -389,7 +390,7 @@ call(ServerRef, Request, Timeout) -> end. %% Reply from a state machine callback to whom awaits in call/2 --spec reply([reply_operation()] | reply_operation()) -> ok. +-spec reply([reply_action()] | reply_action()) -> ok. reply({reply,{_To,_Tag}=Client,Reply}) -> reply(Client, Reply); reply(Replies) when is_list(Replies) -> @@ -411,39 +412,39 @@ reply({To,Tag}, Reply) -> %% started by proc_lib into a state machine using %% the same arguments as you would have returned from init/1 -spec enter_loop( - Module :: module(), Options :: [debug_opt()], - State :: state(), StateData :: state_data()) -> + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data()) -> no_return(). -enter_loop(Module, Options, State, StateData) -> - enter_loop(Module, Options, State, StateData, self()). +enter_loop(Module, Opts, State, Data) -> + enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( - Module :: module(), Options :: [debug_opt()], - State :: state(), StateData :: state_data(), - Server_or_StateOps :: - server_name() | pid() | [state_op()|init_option()]) -> + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), + Server_or_Ops :: + server_name() | pid() | [transition_op()|init_option()]) -> no_return(). -enter_loop(Module, Options, State, StateData, Server_or_StateOps) -> +enter_loop(Module, Opts, State, Data, Server_or_Ops) -> if - is_list(Server_or_StateOps) -> + is_list(Server_or_Ops) -> enter_loop( - Module, Options, State, StateData, - self(), Server_or_StateOps); + Module, Opts, State, Data, + self(), Server_or_Ops); true -> enter_loop( - Module, Options, State, StateData, - Server_or_StateOps, []) + Module, Opts, State, Data, + Server_or_Ops, []) end. %% -spec enter_loop( - Module :: module(), Options :: [debug_opt()], - State :: state(), StateData :: state_data(), + Module :: module(), Opts :: [debug_opt()], + State :: state(), Data :: data(), Server :: server_name() | pid(), - StateOps :: [state_op()|init_option()]) -> + Ops :: [transition_op()|init_option()]) -> no_return(). -enter_loop(Module, Options, State, StateData, Server, StateOps) -> +enter_loop(Module, Opts, State, Data, Server, Ops) -> Parent = gen:get_parent(), - enter(Module, Options, State, StateData, Server, StateOps, Parent). + enter(Module, Opts, State, Data, Server, Ops, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -465,29 +466,29 @@ do_send(Proc, Msg) -> end. %% Here init_it and all enter_loop functions converge -enter(Module, Options, State, StateData, Server, InitOps, Parent) -> +enter(Module, Opts, State, Data, Server, InitOps, Parent) -> Name = gen:get_proc_name(Server), - Debug = gen:debug_options(Name, Options), + Debug = gen:debug_options(Name, Opts), PrevState = undefined, S = #{ callback_mode => state_functions, module => Module, name => Name, prev_state => PrevState, - state => PrevState, % Will be discarded by loop_event_state_ops - state_data => StateData, + state => PrevState, % Will be discarded by loop_event_transition_ops + data => Data, timer => undefined, postponed => [], hibernate => false}, case collect_init_options(InitOps) of - {CallbackMode,StateOps} -> - loop_event_state_ops( + {CallbackMode,Ops} -> + loop_event_transition_ops( Parent, Debug, S#{callback_mode := CallbackMode}, [], {event,undefined}, % Will be discarded by {postpone,false} - PrevState, State, StateData, - StateOps++[{postpone,false}]); + PrevState, State, Data, + Ops++[{postpone,false}]); [Reason] -> ?TERMINATE(Reason, Debug, S, []) end. @@ -495,13 +496,13 @@ enter(Module, Options, State, StateData, Server, InitOps, Parent) -> %%%========================================================================== %%% gen callbacks -init_it(Starter, Parent, ServerRef, Module, Args, Options) -> +init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> try Module:init(Args) of Result -> - init_result(Starter, Parent, ServerRef, Module, Result, Options) + init_result(Starter, Parent, ServerRef, Module, Result, Opts) catch Result -> - init_result(Starter, Parent, ServerRef, Module, Result, Options); + init_result(Starter, Parent, ServerRef, Module, Result, Opts); Class:Reason -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -511,18 +512,14 @@ init_it(Starter, Parent, ServerRef, Module, Args, Options) -> %%--------------------------------------------------------------------------- %% gen callbacks helpers -init_result(Starter, Parent, ServerRef, Module, Result, Options) -> +init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of - {ok,State,StateData} -> + {ok,State,Data} -> proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Options, State, StateData, ServerRef, - [], Parent); - {ok,State,StateData,StateOps} -> + enter(Module, Opts, State, Data, ServerRef, [], Parent); + {ok,State,Data,Ops} -> proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Options, State, StateData, ServerRef, - StateOps, Parent); + enter(Module, Opts, State, Data, ServerRef, Ops, Parent); {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -549,32 +546,32 @@ system_terminate(Reason, _Parent, Debug, S) -> system_code_change( #{module := Module, state := State, - state_data := StateData} = S, + data := Data} = S, _Mod, OldVsn, Extra) -> case - try Module:code_change(OldVsn, State, StateData, Extra) + try Module:code_change(OldVsn, State, Data, Extra) catch Result -> Result end of - {ok,{NewState,NewStateData}} -> + {ok,{NewState,NewData}} -> {ok, S#{ state := NewState, - state_data := NewStateData}}; + data := NewData}}; Error -> Error end. -system_get_state(#{state := State, state_data := StateData}) -> - {ok,{State,StateData}}. +system_get_state(#{state := State, data := Data}) -> + {ok,{State,Data}}. system_replace_state( StateFun, #{state := State, - state_data := StateData} = S) -> - {NewState,NewStateData} = Result = StateFun({State,StateData}), - {ok,Result,S#{state := NewState, state_data := NewStateData}}. + data := Data} = S) -> + {NewState,NewData} = Result = StateFun({State,Data}), + {ok,Result,S#{state := NewState, data := NewData}}. format_status( Opt, @@ -642,7 +639,7 @@ wakeup_from_hibernate(Parent, Debug, S) -> loop_receive(Parent, Debug, S). %%%========================================================================== -%%% STate Machine engine implementation of proc_lib/gen server +%%% State Machine engine implementation of proc_lib/gen server %% Server loop, consists of all loop* functions %% and some detours through sys and proc_lib @@ -717,7 +714,7 @@ loop_events( module := Module, prev_state := PrevState, state := State, - state_data := StateData} = S, + data := Data} = S, [{Type,Content} = Event|Events] = Q, Timer) -> _ = (Timer =/= undefined) andalso cancel_timer(Timer), @@ -728,7 +725,7 @@ loop_events( state_functions -> State end, - try Module:Func(Type, Content, PrevState, State, StateData) of + try Module:Func(Type, Content, PrevState, State, Data) of Result -> loop_event_result( Parent, Debug, S, Events, Event, Result) @@ -741,7 +738,7 @@ loop_events( %% of calling a nonexistent state function case erlang:get_stacktrace() of [{Module,Func, - [Type,Content,PrevState,State,StateData]=Args, + [Type,Content,PrevState,State,Data]=Args, _} |Stacktrace] -> terminate( @@ -760,18 +757,18 @@ loop_events( %% Interpret all callback return value variants loop_event_result( Parent, Debug, - #{state := State, state_data := StateData} = S, + #{state := State, data := Data} = S, Events, Event, Result) -> case Result of {stop,Reason} -> ?TERMINATE(Reason, Debug, S, [Event|Events]); - {stop,Reason,NewStateData} -> + {stop,Reason,NewData} -> ?TERMINATE( Reason, Debug, - S#{state_data := NewStateData}, + S#{data := NewData}, [Event|Events]); - {stop,Reason,Reply,NewStateData} -> - NewS = S#{state_data := NewStateData}, + {stop,Reason,Reply,NewData} -> + NewS = S#{data := NewData}, Q = [Event|Events], Replies = if @@ -785,43 +782,43 @@ loop_event_result( exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad ?TERMINATE( - {bad_return_value,{stop,Reason,BadReplies,NewStateData}}, + {bad_return_value,{stop,Reason,BadReplies,NewData}}, Debug, NewS, Q); - {next_state,NewState,NewStateData} -> - loop_event_state_ops( + {next_state,NewState,NewData} -> + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, NewState, NewStateData, []); - {next_state,NewState,NewStateData,StateOps} - when is_list(StateOps) -> - loop_event_state_ops( + State, NewState, NewData, []); + {next_state,NewState,NewData,Ops} + when is_list(Ops) -> + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, NewState, NewStateData, StateOps); - {keep_state,NewStateData} -> - loop_event_state_ops( + State, NewState, NewData, Ops); + {keep_state,NewData} -> + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, State, NewStateData, []); - {keep_state,NewStateData,StateOps} -> - loop_event_state_ops( + State, State, NewData, []); + {keep_state,NewData,Ops} -> + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, State, NewStateData, StateOps); + State, State, NewData, Ops); {keep_state_and_data} -> - loop_event_state_ops( + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, State, StateData, []); - {keep_state_and_data,StateOps} -> - loop_event_state_ops( + State, State, Data, []); + {keep_state_and_data,Ops} -> + loop_event_transition_ops( Parent, Debug, S, Events, Event, - State, State, StateData, StateOps); + State, State, Data, Ops); _ -> ?TERMINATE( {bad_return_value,Result}, Debug, S, [Event|Events]) end. -loop_event_state_ops( +loop_event_transition_ops( Parent, Debug0, #{postponed := P0} = S, Events, Event, - State, NewState, NewStateData, StateOps) -> - case collect_state_options(StateOps) of - {Postpone,Hibernate,Timeout,Operations} -> + State, NewState, NewData, Ops) -> + case collect_transition_options(Ops) of + {Postpone,Hibernate,Timeout,Actions} -> P1 = % Move current event to postponed if Postpone case Postpone of true -> @@ -837,8 +834,8 @@ loop_event_state_ops( {lists:reverse(P1, Events),[]} end, %% - case process_state_operations( - Operations, Debug0, S, Q2, P2) of + case process_transition_actions( + Actions, Debug0, S, Q2, P2) of {Debug,Q3,P} -> NewDebug = sys_debug( @@ -865,7 +862,7 @@ loop_event_state_ops( S#{ prev_state := State, state := NewState, - state_data := NewStateData, + data := NewData, timer := Timer, hibernate := Hibernate, postponed := P}, @@ -892,92 +889,96 @@ collect_init_options(InitOps) -> collect_init_options([InitOps], state_functions, []) end. %% Keep the last of each kind -collect_init_options([], CallbackMode, StateOps) -> - {CallbackMode,lists:reverse(StateOps)}; -collect_init_options([InitOp|InitOps] = IOIOs, CallbackMode, StateOps) -> +collect_init_options([], CallbackMode, Ops) -> + {CallbackMode,lists:reverse(Ops)}; +collect_init_options( + [InitOp|InitOps] = AllInitOps, CallbackMode, Ops) -> case InitOp of {callback_mode,Mode} when Mode =:= state_functions; Mode =:= handle_event_function -> - collect_init_options(InitOps, Mode, StateOps); + collect_init_options(InitOps, Mode, Ops); {callback_mode,_} -> - [{bad_init_ops,IOIOs}]; - _ -> % Collect others as StateOps + [{bad_init_ops,AllInitOps}]; + _ -> % Collect others as Ops collect_init_options( - InitOps, CallbackMode, [InitOp|StateOps]) + InitOps, CallbackMode, [InitOp|Ops]) end. -collect_state_options(StateOps) -> +collect_transition_options(Ops) -> if - is_list(StateOps) -> - collect_state_options(StateOps, false, false, undefined, []); + is_list(Ops) -> + collect_transition_options( + Ops, false, false, undefined, []); true -> - collect_state_options([StateOps], false, false, undefined, []) + collect_transition_options( + [Ops], false, false, undefined, []) end. %% Keep the last of each kind -collect_state_options( - [], Postpone, Hibernate, Timeout, Operations) -> - {Postpone,Hibernate,Timeout,lists:reverse(Operations)}; -collect_state_options( - [StateOp|StateOps] = SOSOs, Postpone, Hibernate, Timeout, Operations) -> - case StateOp of +collect_transition_options( + [], Postpone, Hibernate, Timeout, Actions) -> + {Postpone,Hibernate,Timeout,lists:reverse(Actions)}; +collect_transition_options( + [Op|Ops] = AllOps, Postpone, Hibernate, Timeout, Actions) -> + case Op of postpone -> - collect_state_options( - StateOps, true, Hibernate, Timeout, Operations); + collect_transition_options( + Ops, true, Hibernate, Timeout, Actions); {postpone,NewPostpone} when is_boolean(NewPostpone) -> - collect_state_options( - StateOps, NewPostpone, Hibernate, Timeout, Operations); + collect_transition_options( + Ops, NewPostpone, Hibernate, Timeout, Actions); {postpone,_} -> - [{bad_state_ops,SOSOs}]; + [{bad_ops,AllOps}]; hibernate -> - collect_state_options( - StateOps, Postpone, true, Timeout, Operations); + collect_transition_options( + Ops, Postpone, true, Timeout, Actions); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - collect_state_options( - StateOps, Postpone, NewHibernate, Timeout, Operations); + collect_transition_options( + Ops, Postpone, NewHibernate, Timeout, Actions); {hibernate,_} -> - [{bad_state_ops,SOSOs}]; + [{bad_ops,AllOps}]; {timeout,infinity,_} -> % Ignore since it will never time out - collect_state_options( - StateOps, Postpone, Hibernate, undefined, Operations); + collect_transition_options( + Ops, Postpone, Hibernate, undefined, Actions); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> - collect_state_options( - StateOps, Postpone, Hibernate, NewTimeout, Operations); + collect_transition_options( + Ops, Postpone, Hibernate, NewTimeout, Actions); {timeout,_,_} -> - [{bad_state_ops,SOSOs}]; - _ -> % Collect others as operations - collect_state_options( - StateOps, Postpone, Hibernate, Timeout, [StateOp|Operations]) + [{bad_ops,AllOps}]; + _ -> % Collect others as actions + collect_transition_options( + Ops, Postpone, Hibernate, Timeout, [Op|Actions]) end. -process_state_operations([], Debug, _S, Q, P) -> +process_transition_actions([], Debug, _S, Q, P) -> {Debug,Q,P}; -process_state_operations([Operation|Operations] = OOs, Debug, S, Q, P) -> - case Operation of +process_transition_actions( + [Action|Actions] = AllActions, Debug, S, Q, P) -> + case Action of {reply,{_To,_Tag}=Client,Reply} -> NewDebug = do_reply(Debug, S, Client, Reply), - process_state_operations(Operations, NewDebug, S, Q, P); + process_transition_actions(Actions, NewDebug, S, Q, P); {next_event,Type,Content} -> case event_type(Type) of true -> - process_state_operations( - Operations, Debug, S, [{Type,Content}|Q], P); + process_transition_actions( + Actions, Debug, S, [{Type,Content}|Q], P); false -> - [{bad_state_ops,OOs},Debug] + [{bad_ops,AllActions},Debug] end; _ -> - %% All others are remove operations - case remove_fun(Operation) of + %% All others are remove actions + case remove_fun(Action) of false -> - process_state_operations( - Operations, Debug, S, Q, P); + process_transition_actions( + Actions, Debug, S, Q, P); undefined -> - [{bad_state_ops,OOs},Debug]; + [{bad_ops,AllActions},Debug]; RemoveFun when is_function(RemoveFun, 2) -> case remove_event(RemoveFun, Q, P) of {NewQ,NewP} -> - process_state_operations( - Operations, Debug, S, NewQ, NewP); + process_transition_actions( + Actions, Debug, S, NewQ, NewP); Error -> Error ++ [Debug] end; @@ -1023,7 +1024,8 @@ remove_event(RemoveFun, Q, P) -> [Class,Reason,erlang:get_stacktrace()] end. -%% Do the given state operation and create an event removal predicate fun() +%% Do the given transition action and create +%% an event removal predicate fun() remove_fun({remove_event,Type,Content}) -> fun (T, C) when T =:= Type, C =:= Content -> true; (_, _) -> false @@ -1104,9 +1106,9 @@ cancel_timer(TimerRef) -> terminate( Class, Reason, Stacktrace, Debug, #{module := Module, - state := State, state_data := StateData} = S, + state := State, data := Data} = S, Q) -> - try Module:terminate(Reason, State, StateData) of + try Module:terminate(Reason, State, Data) of _ -> ok catch _ -> ok; @@ -1137,7 +1139,7 @@ error_info( Class, Reason, Stacktrace, Debug, #{name := Name, callback_mode := CallbackMode, state := State, postponed := P}, - Q, FmtStateData) -> + Q, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1190,7 +1192,7 @@ error_info( [Event|_] -> [Event] end] ++ - [FmtStateData,Class,FixedReason, + [FmtData,Class,FixedReason, State,CallbackMode,length(Q),length(P)] ++ case FixedStacktrace of [] -> @@ -1205,22 +1207,22 @@ error_info( %% Call Module:format_status/2 or return a default value format_status( Opt, PDict, - #{module := Module, state := State, state_data := StateData}) -> + #{module := Module, state := State, data := Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> - try Module:format_status(Opt, [PDict,State,StateData]) + try Module:format_status(Opt, [PDict,State,Data]) catch Result -> Result; _:_ -> - format_status_default(Opt, State, StateData) + format_status_default(Opt, State, Data) end; false -> - format_status_default(Opt, State, StateData) + format_status_default(Opt, State, Data) end. %% The default Module:format_status/2 -format_status_default(Opt, State, StateData) -> - SSD = {State,StateData}, +format_status_default(Opt, State, Data) -> + SSD = {State,Data}, case Opt of terminate -> SSD; -- cgit v1.2.3 From 867c27c5b03c846aef1e5fe4b3ee63de5f3a7f32 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 19 Feb 2016 15:36:13 +0100 Subject: Hide Data in default format_status/2 if callback crashes --- lib/stdlib/src/gen_statem.erl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 1ca2e1009c..b580eaab97 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1214,7 +1214,9 @@ format_status( catch Result -> Result; _:_ -> - format_status_default(Opt, State, Data) + format_status_default( + Opt, State, + "Module:format_status/2 crashed") end; false -> format_status_default(Opt, State, Data) -- cgit v1.2.3 From 759548838fa8b27eaa574233c9897d9578540a5a Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 22 Feb 2016 14:55:52 +0100 Subject: Make callback_option() mandatory --- lib/stdlib/src/gen_statem.erl | 131 ++++++++++++++++++++---------------------- 1 file changed, 63 insertions(+), 68 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index b580eaab97..32799f5afc 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -24,7 +24,7 @@ [start/3,start/4,start_link/3,start_link/4, stop/1,stop/3, cast/2,call/2,call/3, - enter_loop/4,enter_loop/5,enter_loop/6, + enter_loop/5,enter_loop/6,enter_loop/7, reply/1,reply/2]). %% gen callbacks @@ -63,8 +63,6 @@ 'info' | 'timeout' | 'internal'. -type event_predicate() :: % Return true for the event in question fun((event_type(), term()) -> boolean()). --type init_option() :: - {'callback_mode', callback_mode()}. -type callback_mode() :: 'state_functions' | 'handle_event_function'. -type transition_op() :: %% First NewState and NewData are set, @@ -136,12 +134,12 @@ %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. -callback init(Args :: term()) -> - {'ok', state(), data()} | - {'ok', state(), data(), [transition_op()|init_option()]} | + {callback_mode(), state(), data()} | + {callback_mode(), state(), data(), [transition_op()]} | 'ignore' | {'stop', Reason :: term()}. -%% Example callback for callback_mode =:= state_functions +%% Example state callback for callback_mode() =:= state_functions %% state name 'state_name'. %% %% In this mode all states has to be type state_name() i.e atom(). @@ -156,7 +154,7 @@ Data :: data()) -> state_callback_result(). %% -%% Callback for callback_mode =:= handle_event_function. +%% State callback for callback_mode() =:= handle_event_function. %% %% Note that state callbacks and only state callbacks have arity 5 %% and that is intended. @@ -199,7 +197,8 @@ StatusOption :: 'normal' | 'terminate'. -optional_callbacks( - [format_status/2, % Has got a default implementation + [init/1, % One may use enter_loop/5,6,7 instead + format_status/2, % Has got a default implementation %% state_name/5, % Example for callback_mode =:= state_functions: %% there has to be a StateName/5 callback function for every StateName. @@ -207,6 +206,16 @@ handle_event/5]). % For callback_mode =:= handle_event_function %% Type validation functions +callback_mode(CallbackMode) -> + case CallbackMode of + state_functions -> + true; + handle_event_function -> + true; + _ -> + false + end. +%% client({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> true; client(_) -> @@ -413,38 +422,41 @@ reply({To,Tag}, Reply) -> %% the same arguments as you would have returned from init/1 -spec enter_loop( Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), State :: state(), Data :: data()) -> no_return(). -enter_loop(Module, Opts, State, Data) -> - enter_loop(Module, Opts, State, Data, self()). +enter_loop(Module, Opts, CallbackMode, State, Data) -> + enter_loop(Module, Opts, CallbackMode, State, Data, self()). %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server_or_Ops :: - server_name() | pid() | [transition_op()|init_option()]) -> + server_name() | pid() | [transition_op()]) -> no_return(). -enter_loop(Module, Opts, State, Data, Server_or_Ops) -> +enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Ops) -> if is_list(Server_or_Ops) -> enter_loop( - Module, Opts, State, Data, + Module, Opts, CallbackMode, State, Data, self(), Server_or_Ops); true -> enter_loop( - Module, Opts, State, Data, + Module, Opts, CallbackMode, State, Data, Server_or_Ops, []) end. %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server :: server_name() | pid(), - Ops :: [transition_op()|init_option()]) -> + Ops :: [transition_op()]) -> no_return(). -enter_loop(Module, Opts, State, Data, Server, Ops) -> +enter_loop(Module, Opts, CallbackMode, State, Data, Server, Ops) -> Parent = gen:get_parent(), - enter(Module, Opts, State, Data, Server, Ops, Parent). + enter(Module, Opts, CallbackMode, State, Data, Server, Ops, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -465,37 +477,40 @@ do_send(Proc, Msg) -> ok end. -%% Here init_it and all enter_loop functions converge -enter(Module, Opts, State, Data, Server, InitOps, Parent) -> - Name = gen:get_proc_name(Server), - Debug = gen:debug_options(Name, Opts), - PrevState = undefined, - S = #{ - callback_mode => state_functions, - module => Module, - name => Name, - prev_state => PrevState, - state => PrevState, % Will be discarded by loop_event_transition_ops - data => Data, - timer => undefined, - postponed => [], - hibernate => false}, - case collect_init_options(InitOps) of - {CallbackMode,Ops} -> +%% Here init_it/6 and enter_loop/5,6,7 functions converge +enter(Module, Opts, CallbackMode, State, Data, Server, Ops, Parent) + when is_atom(Module), is_pid(Parent) -> + case callback_mode(CallbackMode) of + true -> + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Opts), + PrevState = undefined, + S = #{ + callback_mode => CallbackMode, + module => Module, + name => Name, + prev_state => PrevState, + state => PrevState, % Discarded by loop_event_transition_ops + data => Data, + timer => undefined, + postponed => [], + hibernate => false}, loop_event_transition_ops( - Parent, Debug, - S#{callback_mode := CallbackMode}, - [], - {event,undefined}, % Will be discarded by {postpone,false} + Parent, Debug, S, [], + {event,undefined}, % Discarded due to {postpone,false} PrevState, State, Data, Ops++[{postpone,false}]); - [Reason] -> - ?TERMINATE(Reason, Debug, S, []) + false -> + erlang:error( + badarg, + [Module,Opts,CallbackMode,State,Data,Server,Ops,Parent]) end. %%%========================================================================== %%% gen callbacks +init_it(Starter, self, ServerRef, Module, Args, Opts) -> + init_it(Starter, self(), ServerRef, Module, Args, Opts); init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> try Module:init(Args) of Result -> @@ -514,12 +529,16 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of - {ok,State,Data} -> + {CallbackMode,State,Data} -> proc_lib:init_ack(Starter, {ok,self()}), - enter(Module, Opts, State, Data, ServerRef, [], Parent); - {ok,State,Data,Ops} -> + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, [], Parent); + {CallbackMode,State,Data,Ops} -> proc_lib:init_ack(Starter, {ok,self()}), - enter(Module, Opts, State, Data, ServerRef, Ops, Parent); + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, Ops, Parent); {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -881,30 +900,6 @@ loop_event_transition_ops( %%--------------------------------------------------------------------------- %% Server helpers -collect_init_options(InitOps) -> - if - is_list(InitOps) -> - collect_init_options(InitOps, state_functions, []); - true -> - collect_init_options([InitOps], state_functions, []) - end. -%% Keep the last of each kind -collect_init_options([], CallbackMode, Ops) -> - {CallbackMode,lists:reverse(Ops)}; -collect_init_options( - [InitOp|InitOps] = AllInitOps, CallbackMode, Ops) -> - case InitOp of - {callback_mode,Mode} - when Mode =:= state_functions; - Mode =:= handle_event_function -> - collect_init_options(InitOps, Mode, Ops); - {callback_mode,_} -> - [{bad_init_ops,AllInitOps}]; - _ -> % Collect others as Ops - collect_init_options( - InitOps, CallbackMode, [InitOp|Ops]) - end. - collect_transition_options(Ops) -> if is_list(Ops) -> -- cgit v1.2.3 From 793fe40e3883bca7c37b71fb59616a4ec8d379b1 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 23 Feb 2016 16:55:45 +0100 Subject: Rename Client -> Caller --- lib/stdlib/src/gen_statem.erl | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 32799f5afc..48dfaec42a 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -51,7 +51,7 @@ %%% Interface functions. %%%========================================================================== --type client() :: +-type caller() :: {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: state_name() | % For state callback function StateName/5 @@ -59,7 +59,7 @@ -type state_name() :: atom(). -type data() :: term(). -type event_type() :: - {'call',Client :: client()} | 'cast' | + {'call',Caller :: caller()} | 'cast' | 'info' | 'timeout' | 'internal'. -type event_predicate() :: % Return true for the event in question fun((event_type(), term()) -> boolean()). @@ -101,8 +101,8 @@ {'unlink', % Unlink and clean up mess(ages) Id :: pid() | port()}. -type reply_action() :: - {'reply', % Reply to a client - Client :: client(), Reply :: term()}. + {'reply', % Reply to a caller + Caller :: caller(), Reply :: term()}. -type state_callback_result() :: {'stop', % Stop the server Reason :: term()} | @@ -216,13 +216,13 @@ callback_mode(CallbackMode) -> false end. %% -client({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> +caller({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> true; -client(_) -> +caller(_) -> false. %% -event_type({call,Client}) -> - client(Client); +event_type({call,Caller}) -> + caller(Caller); event_type(Type) -> case Type of cast -> @@ -341,7 +341,7 @@ cast(ServerRef, Msg) when is_pid(ServerRef) -> do_send(ServerRef, cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that -%% arrives with type {call,Client} +%% arrives with type {call,Caller} -spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). call(ServerRef, Request) -> call(ServerRef, Request, infinity). @@ -400,13 +400,13 @@ call(ServerRef, Request, Timeout) -> %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. -reply({reply,{_To,_Tag}=Client,Reply}) -> - reply(Client, Reply); +reply({reply,{_To,_Tag}=Caller,Reply}) -> + reply(Caller, Reply); reply(Replies) when is_list(Replies) -> [reply(Reply) || Reply <- Replies], ok. %% --spec reply(Client :: client(), Reply :: term()) -> ok. +-spec reply(Caller :: caller(), Reply :: term()) -> ok. reply({To,Tag}, Reply) -> Msg = {Tag,Reply}, try To ! Msg of @@ -703,8 +703,8 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> Event = case Msg of - {'$gen_call',Client,Request} -> - {{call,Client},Request}; + {'$gen_call',Caller,Request} -> + {{call,Caller},Request}; {'$gen_cast',E} -> {cast,E}; _ -> @@ -950,8 +950,8 @@ process_transition_actions([], Debug, _S, Q, P) -> process_transition_actions( [Action|Actions] = AllActions, Debug, S, Q, P) -> case Action of - {reply,{_To,_Tag}=Client,Reply} -> - NewDebug = do_reply(Debug, S, Client, Reply), + {reply,{_To,_Tag}=Caller,Reply} -> + NewDebug = do_reply(Debug, S, Caller, Reply), process_transition_actions(Actions, NewDebug, S, Q, P); {next_event,Type,Content} -> case event_type(Type) of @@ -987,17 +987,17 @@ reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> reply_then_terminate( Class, Reason, Stacktrace, Debug, S, Q, [R|Rs] = RRs) -> case R of - {reply,{_To,_Tag}=Client,Reply} -> - NewDebug = do_reply(Debug, S, Client, Reply), + {reply,{_To,_Tag}=Caller,Reply} -> + NewDebug = do_reply(Debug, S, Caller, Reply), reply_then_terminate( Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> RRs % bad_return_value end. -do_reply(Debug, S, Client, Reply) -> - reply(Client, Reply), - sys_debug(Debug, S, {out,Reply,Client}). +do_reply(Debug, S, Caller, Reply) -> + reply(Caller, Reply), + sys_debug(Debug, S, {out,Reply,Caller}). %% Remove oldest matching event from the queue(s) -- cgit v1.2.3 From 2b3a82ae44b222ce1146badcff972abb539d40ca Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 23 Feb 2016 17:58:45 +0100 Subject: Add {stop_and_reply,Reason,Replies [,Data]) Cleanup some error handling --- lib/stdlib/src/gen_statem.erl | 83 ++++++++++++++++++++++++------------------- 1 file changed, 46 insertions(+), 37 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 48dfaec42a..02c8d60c61 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -109,7 +109,10 @@ {'stop', % Stop the server Reason :: term(), NewData :: data()} | - {'stop', % Stop the server + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action()} | + {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action(), NewData :: data()} | @@ -244,9 +247,9 @@ event_type(Type) -> try throw(ok) catch _ -> erlang:get_stacktrace() end). -define( - TERMINATE(Reason, Debug, S, Q), + TERMINATE(Class, Reason, Debug, S, Q), terminate( - exit, + Class, begin Reason end, ?STACKTRACE(), begin Debug end, @@ -560,7 +563,7 @@ system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). system_terminate(Reason, _Parent, Debug, S) -> - ?TERMINATE(Reason, Debug, S, []). + ?TERMINATE(exit, Reason, Debug, S, []). system_code_change( #{module := Module, @@ -696,7 +699,7 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... - ?TERMINATE(Reason, Debug, S, [EXIT]); + ?TERMINATE(exit, Reason, Debug, S, [EXIT]); {timeout,Timer,Content} when Timer =/= undefined -> loop_receive( Parent, Debug, S, {timeout,Content}, undefined); @@ -780,29 +783,26 @@ loop_event_result( Events, Event, Result) -> case Result of {stop,Reason} -> - ?TERMINATE(Reason, Debug, S, [Event|Events]); + ?TERMINATE(exit, Reason, Debug, S, [Event|Events]); {stop,Reason,NewData} -> - ?TERMINATE( - Reason, Debug, - S#{data := NewData}, - [Event|Events]); - {stop,Reason,Reply,NewData} -> NewS = S#{data := NewData}, Q = [Event|Events], - Replies = - if - is_list(Reply) -> - Reply; - true -> - [Reply] - end, - BadReplies = + ?TERMINATE(exit, Reason, Debug, NewS, Q); + {stop_and_reply,Reason,Replies} -> + Q = [Event|Events], + [Class,NewReason,Stacktrace,NewDebug] = + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, S, Q, Replies), + %% Since we got back here Replies was bad + terminate(Class, NewReason, Stacktrace, NewDebug, S, Q); + {stop_and_reply,Reason,Replies,NewData} -> + NewS = S#{data := NewData}, + Q = [Event|Events], + [Class,NewReason,Stacktrace,NewDebug] = reply_then_terminate( exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad - ?TERMINATE( - {bad_return_value,{stop,Reason,BadReplies,NewData}}, - Debug, NewS, Q); + terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); {next_state,NewState,NewData} -> loop_event_transition_ops( Parent, Debug, S, Events, Event, @@ -830,7 +830,7 @@ loop_event_result( State, State, Data, Ops); _ -> ?TERMINATE( - {bad_return_value,Result}, Debug, S, [Event|Events]) + error, {bad_return_value,Result}, Debug, S, [Event|Events]) end. loop_event_transition_ops( @@ -886,15 +886,14 @@ loop_event_transition_ops( hibernate := Hibernate, postponed := P}, Q, Timer); - [Reason,Debug] -> - ?TERMINATE(Reason, Debug, S, [Event|Events]); [Class,Reason,Stacktrace,Debug] -> terminate( Class, Reason, Stacktrace, Debug, S, [Event|Events]) end; %% - [Reason] -> - ?TERMINATE(Reason, Debug0, S, [Event|Events]) + [Class,Reason,Stacktrace] -> + terminate( + Class, Reason, Stacktrace, Debug0, S, [Event|Events]) end. %%--------------------------------------------------------------------------- @@ -923,7 +922,7 @@ collect_transition_options( collect_transition_options( Ops, NewPostpone, Hibernate, Timeout, Actions); {postpone,_} -> - [{bad_ops,AllOps}]; + [error,{bad_ops,AllOps},?STACKTRACE()]; hibernate -> collect_transition_options( Ops, Postpone, true, Timeout, Actions); @@ -931,7 +930,7 @@ collect_transition_options( collect_transition_options( Ops, Postpone, NewHibernate, Timeout, Actions); {hibernate,_} -> - [{bad_ops,AllOps}]; + [error,{bad_ops,AllOps},?STACKTRACE()]; {timeout,infinity,_} -> % Ignore since it will never time out collect_transition_options( Ops, Postpone, Hibernate, undefined, Actions); @@ -939,7 +938,7 @@ collect_transition_options( collect_transition_options( Ops, Postpone, Hibernate, NewTimeout, Actions); {timeout,_,_} -> - [{bad_ops,AllOps}]; + [error,{bad_ops,AllOps},?STACKTRACE()]; _ -> % Collect others as actions collect_transition_options( Ops, Postpone, Hibernate, Timeout, [Op|Actions]) @@ -959,7 +958,7 @@ process_transition_actions( process_transition_actions( Actions, Debug, S, [{Type,Content}|Q], P); false -> - [{bad_ops,AllActions},Debug] + [error,{bad_ops,AllActions},?STACKTRACE(),Debug] end; _ -> %% All others are remove actions @@ -968,7 +967,7 @@ process_transition_actions( process_transition_actions( Actions, Debug, S, Q, P); undefined -> - [{bad_ops,AllActions},Debug]; + [error,{bad_ops,AllActions},?STACKTRACE(),Debug]; RemoveFun when is_function(RemoveFun, 2) -> case remove_event(RemoveFun, Q, P) of {NewQ,NewP} -> @@ -982,17 +981,27 @@ process_transition_actions( end end. -reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> + if + is_list(Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, Replies); + true -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [Replies]) + end. +%% +do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> terminate(Class, Reason, Stacktrace, Debug, S, Q); -reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs] = RRs) -> +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs] = Replies) -> case R of {reply,{_To,_Tag}=Caller,Reply} -> NewDebug = do_reply(Debug, S, Caller, Reply), - reply_then_terminate( + do_reply_then_terminate( Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> - RRs % bad_return_value + [error,{bad_replies,Replies},?STACKTRACE(),Debug] end. do_reply(Debug, S, Caller, Reply) -> -- cgit v1.2.3 From 1958b93b4aa90883be5102d465f67f167549dea9 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 24 Feb 2016 09:41:34 +0100 Subject: Ditch State so StateName/5 -> StateName/4 --- lib/stdlib/src/gen_statem.erl | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 02c8d60c61..fe84a428f6 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -152,8 +152,7 @@ -callback state_name( event_type(), EventContent :: term(), - PrevStateName :: state_name() | reference(), - StateName :: state_name(), % Current state + PrevStateName :: state_name(), % Previous state name Data :: data()) -> state_callback_result(). %% @@ -164,7 +163,7 @@ -callback handle_event( event_type(), EventContent :: term(), - PrevState :: state(), + PrevState :: state(), % Previous state State :: state(), % Current state Data :: data()) -> state_callback_result(). @@ -203,7 +202,7 @@ [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation %% - state_name/5, % Example for callback_mode =:= state_functions: + state_name/4, % Example for callback_mode =:= state_functions: %% there has to be a StateName/5 callback function for every StateName. %% handle_event/5]). % For callback_mode =:= handle_event_function @@ -740,14 +739,13 @@ loop_events( [{Type,Content} = Event|Events] = Q, Timer) -> _ = (Timer =/= undefined) andalso cancel_timer(Timer), - Func = + try case CallbackMode of - handle_event_function -> - handle_event; state_functions -> - State - end, - try Module:Func(Type, Content, PrevState, State, Data) of + Module:State(Type, Content, PrevState, Data); + handle_event_function -> + Module:handle_event(Type, Content, PrevState, State, Data) + end of Result -> loop_event_result( Parent, Debug, S, Events, Event, Result) @@ -759,15 +757,27 @@ loop_events( %% Process an undef to check for the simple mistake %% of calling a nonexistent state function case erlang:get_stacktrace() of - [{Module,Func, - [Type,Content,PrevState,State,Data]=Args, + [{Module,State, + [Type,Content,PrevState,Data]=Args, _} - |Stacktrace] -> + |Stacktrace] + when CallbackMode =:= state_functions -> terminate( error, {undef_state_function,{Module,State,Args}}, Stacktrace, Debug, S, Q); + [{Module,handle_event, + [Type,Content,PrevState,State,Data]=Args, + _} + |Stacktrace] + when CallbackMode =:= handle_event_function -> + terminate( + error, + {undef_state_function, + {Module,handle_event,Args}}, + Stacktrace, + Debug, S, Q); Stacktrace -> terminate(error, undef, Stacktrace, Debug, S, Q) end; -- cgit v1.2.3 From 8b16506b0763d13b69aef3baeabef4729c708fe5 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 24 Feb 2016 15:50:29 +0100 Subject: Make first next_event in list arrive first Define options as actions that set options, rework the documentation about this. --- lib/stdlib/src/gen_statem.erl | 439 ++++++++++++++++++++++++------------------ 1 file changed, 251 insertions(+), 188 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index fe84a428f6..7fbc1e0f0d 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -45,7 +45,7 @@ [wakeup_from_hibernate/3]). %% Fix problem for doc build --export_type([state_callback_result/0]). +-export_type([transition_option/0,state_callback_result/0]). %%%========================================================================== %%% Interface functions. @@ -53,47 +53,77 @@ -type caller() :: {To :: pid(), Tag :: term()}. % Reply-to specifier for call + -type state() :: state_name() | % For state callback function StateName/5 term(). % For state callback function handle_event/5 + -type state_name() :: atom(). + -type data() :: term(). + -type event_type() :: {'call',Caller :: caller()} | 'cast' | 'info' | 'timeout' | 'internal'. + -type event_predicate() :: % Return true for the event in question fun((event_type(), term()) -> boolean()). + -type callback_mode() :: 'state_functions' | 'handle_event_function'. --type transition_op() :: - %% First NewState and NewData are set, - %% then all transition_action()s are executed in order of - %% apperance. Postponing the current event is performed - %% (iff transition_option() 'postpone' is 'true'). - %% Lastly pending events are processed or if there are - %% no pending events the server goes into receive - %% or hibernate (iff transition_option() 'hibernate' is 'true') - transition_option() | transition_action(). + -type transition_option() :: - %% The last of each kind in the transition_op() - %% list takes precedence - 'postpone' | % Postpone the current event to a different (=/=) state - {'postpone', Postpone :: boolean()} | - 'hibernate' | % Hibernate the server instead of going into receive - {'hibernate', Hibernate :: boolean()} | - (Timeout :: timeout()) | % {timeout,Timeout} - {'timeout', % Generate a ('timeout', Msg, ...) event after Time - Time :: timeout(), Msg :: term()}. --type transition_action() :: - %% These can occur multiple times and are executed in order - %% of appearence in the transition_op() list + postpone() | hibernate() | state_timeout(). +-type postpone() :: + %% If 'true' postpone the current event + %% and retry it when the state changes (=/=) + boolean(). +-type hibernate() :: + %% If 'true' hibernate the server instead of going into receive + boolean(). +-type state_timeout() :: + %% Generate a ('timeout', Msg, ...) event after Time + %% unless some other event is delivered + Time :: timeout(). + +-type action() :: + %% During a state change: + %% * NewState and NewData are set. + %% * All action()s are executed in order of apperance. + %% * Postponing the current event is performed + %% iff 'postpone' is 'true'. + %% * A state timer is started iff 'timeout' is set. + %% * Pending events are processed or if there are + %% no pending events the server goes into receive + %% or hibernate (iff 'hibernate' is 'true') + %% + %% These action()s are executed in order of appearence + %% in the containing list. The ones that set options + %% will override any previous so the last of each kind wins. + %% + 'postpone' | % Set the postpone option + {'postpone', Postpone :: postpone()} | + %% + 'hibernate' | % Set the hibernate option + {'hibernate', Hibernate :: hibernate()} | + %% + (Timeout :: state_timeout()) | % {timeout,Timeout} + {'timeout', % Set the timeout option + Time :: state_timeout(), Msg :: term()} | + %% reply_action() | + %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. {'next_event', % Insert event as the next to handle EventType :: event_type(), EventContent :: term()} | + %% {'remove_event', % Remove the oldest matching (=:=) event EventType :: event_type(), EventContent :: term()} | {'remove_event', % Remove the oldest event satisfying predicate EventPredicate :: event_predicate()} | + %% {'cancel_timer', % Cancel timer and clean up mess(ages) TimerRef :: reference()} | {'demonitor', % Demonitor and clean up mess(ages) @@ -103,6 +133,7 @@ -type reply_action() :: {'reply', % Reply to a caller Caller :: caller(), Reply :: term()}. + -type state_callback_result() :: {'stop', % Stop the server Reason :: term()} | @@ -122,15 +153,16 @@ {'next_state', % State transition, maybe to the same state NewState :: state(), NewData :: data(), - Ops :: [transition_op()] | transition_op()} | + Actions :: [action()] | action()} | {'keep_state', % {keep_state,NewData,[]} NewData :: data()} | {'keep_state', NewData :: data(), - Ops :: [transition_op()] | transition_op()} | + Actions :: [action()] | action()} | {'keep_state_and_data'} | % {keep_state_and_data,[]} {'keep_state_and_data', - Ops :: [transition_op()] | transition_op()}. + Actions :: [action()] | action()}. + %% The state machine init function. It is called only once and %% the server is not running until this function has returned @@ -138,7 +170,7 @@ %% for all events to this server. -callback init(Args :: term()) -> {callback_mode(), state(), data()} | - {callback_mode(), state(), data(), [transition_op()]} | + {callback_mode(), state(), data(), [action()] | action()} | 'ignore' | {'stop', Reason :: term()}. @@ -434,19 +466,19 @@ enter_loop(Module, Opts, CallbackMode, State, Data) -> Module :: module(), Opts :: [debug_opt()], CallbackMode :: callback_mode(), State :: state(), Data :: data(), - Server_or_Ops :: - server_name() | pid() | [transition_op()]) -> + Server_or_Actions :: + server_name() | pid() | [action()]) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Ops) -> +enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> if - is_list(Server_or_Ops) -> + is_list(Server_or_Actions) -> enter_loop( Module, Opts, CallbackMode, State, Data, - self(), Server_or_Ops); + self(), Server_or_Actions); true -> enter_loop( Module, Opts, CallbackMode, State, Data, - Server_or_Ops, []) + Server_or_Actions, []) end. %% -spec enter_loop( @@ -454,11 +486,11 @@ enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Ops) -> CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server :: server_name() | pid(), - Ops :: [transition_op()]) -> + Actions :: [action()] | action()) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server, Ops) -> +enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> Parent = gen:get_parent(), - enter(Module, Opts, CallbackMode, State, Data, Server, Ops, Parent). + enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -480,32 +512,38 @@ do_send(Proc, Msg) -> end. %% Here init_it/6 and enter_loop/5,6,7 functions converge -enter(Module, Opts, CallbackMode, State, Data, Server, Ops, Parent) +enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) when is_atom(Module), is_pid(Parent) -> case callback_mode(CallbackMode) of true -> Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), PrevState = undefined, + NewActions = + if + is_list(Actions) -> + Actions ++ [{postpone,false}]; + true -> + [Actions,{postpone,false}] + end, S = #{ callback_mode => CallbackMode, module => Module, name => Name, prev_state => PrevState, - state => PrevState, % Discarded by loop_event_transition_ops + state => PrevState, % Discarded by loop_event_actions data => Data, timer => undefined, postponed => [], hibernate => false}, - loop_event_transition_ops( + loop_event_actions( Parent, Debug, S, [], {event,undefined}, % Discarded due to {postpone,false} - PrevState, State, Data, - Ops++[{postpone,false}]); + PrevState, State, Data, NewActions); false -> erlang:error( badarg, - [Module,Opts,CallbackMode,State,Data,Server,Ops,Parent]) + [Module,Opts,CallbackMode,State,Data,Server,Actions,Parent]) end. %%%========================================================================== @@ -536,11 +574,11 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> enter( Module, Opts, CallbackMode, State, Data, ServerRef, [], Parent); - {CallbackMode,State,Data,Ops} -> + {CallbackMode,State,Data,Actions} -> proc_lib:init_ack(Starter, {ok,self()}), enter( Module, Opts, CallbackMode, State, Data, - ServerRef, Ops, Parent); + ServerRef, Actions, Parent); {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -814,183 +852,209 @@ loop_event_result( %% Since we got back here Replies was bad terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); {next_state,NewState,NewData} -> - loop_event_transition_ops( + loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, []); - {next_state,NewState,NewData,Ops} - when is_list(Ops) -> - loop_event_transition_ops( + {next_state,NewState,NewData,Actions} + when is_list(Actions) -> + loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Ops); + State, NewState, NewData, Actions); {keep_state,NewData} -> - loop_event_transition_ops( + loop_event_actions( Parent, Debug, S, Events, Event, State, State, NewData, []); - {keep_state,NewData,Ops} -> - loop_event_transition_ops( + {keep_state,NewData,Actions} -> + loop_event_actions( Parent, Debug, S, Events, Event, - State, State, NewData, Ops); + State, State, NewData, Actions); {keep_state_and_data} -> - loop_event_transition_ops( + loop_event_actions( Parent, Debug, S, Events, Event, State, State, Data, []); - {keep_state_and_data,Ops} -> - loop_event_transition_ops( + {keep_state_and_data,Actions} -> + loop_event_actions( Parent, Debug, S, Events, Event, - State, State, Data, Ops); + State, State, Data, Actions); _ -> ?TERMINATE( error, {bad_return_value,Result}, Debug, S, [Event|Events]) end. -loop_event_transition_ops( - Parent, Debug0, #{postponed := P0} = S, Events, Event, - State, NewState, NewData, Ops) -> - case collect_transition_options(Ops) of - {Postpone,Hibernate,Timeout,Actions} -> - P1 = % Move current event to postponed if Postpone - case Postpone of - true -> - [Event|P0]; - false -> - P0 - end, - {Q2,P2} = % Move all postponed events to queue if state change - if - NewState =:= State -> - {Events,P1}; - true -> - {lists:reverse(P1, Events),[]} - end, - %% - case process_transition_actions( - Actions, Debug0, S, Q2, P2) of - {Debug,Q3,P} -> - NewDebug = - sys_debug( - Debug, S, - case Postpone of - true -> - {postpone,Event,NewState}; - false -> - {consume,Event,NewState} - end), - {Timer,Q} = - case Timeout of - undefined -> - {undefined,Q3}; - {timeout,0,Msg} -> - %% Pretend the timeout has just been received - {undefined,Q3 ++ [{timeout,Msg}]}; - {timeout,Time,Msg} -> - {erlang:start_timer(Time, self(), Msg), - Q3} - end, - loop_events( - Parent, NewDebug, - S#{ - prev_state := State, - state := NewState, - data := NewData, - timer := Timer, - hibernate := Hibernate, - postponed := P}, - Q, Timer); - [Class,Reason,Stacktrace,Debug] -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end; - %% - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, Debug0, S, [Event|Events]) - end. - -%%--------------------------------------------------------------------------- -%% Server helpers - -collect_transition_options(Ops) -> - if - is_list(Ops) -> - collect_transition_options( - Ops, false, false, undefined, []); - true -> - collect_transition_options( - [Ops], false, false, undefined, []) - end. -%% Keep the last of each kind -collect_transition_options( - [], Postpone, Hibernate, Timeout, Actions) -> - {Postpone,Hibernate,Timeout,lists:reverse(Actions)}; -collect_transition_options( - [Op|Ops] = AllOps, Postpone, Hibernate, Timeout, Actions) -> - case Op of +loop_event_actions( + Parent, Debug, S, Events, Event, State, NewState, NewData, Actions) -> + loop_event_actions( + Parent, Debug, S, Events, Event, State, NewState, NewData, + false, false, undefined, [], Actions). +%% +loop_event_actions( + Parent, Debug, #{postponed := P0} = S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, []) -> + P1 = % Move current event to postponed if Postpone + case Postpone of + true -> + [Event|P0]; + false -> + P0 + end, + {Timer,Q1} = + case Timeout of + undefined -> + {undefined,Events}; + {timeout,0,Msg} -> + %% Pretend the timeout has just been received + {undefined,Events ++ [{timeout,Msg}]}; + {timeout,Time,Msg} -> + {erlang:start_timer(Time, self(), Msg), + Events} + end, + {Q2,P} = % Move all postponed events to queue if state change + if + NewState =:= State -> + {Q1,P1}; + true -> + {lists:reverse(P1, Q1),[]} + end, + %% Place next events first in queue + Q = lists:reverse(NextEvents, Q2), + %% + NewDebug = + sys_debug( + Debug, S, + case Postpone of + true -> + {postpone,Event,NewState}; + false -> + {consume,Event,NewState} + end), + %% Loop to top; process next event + loop_events( + Parent, NewDebug, + S#{ + prev_state := State, + state := NewState, + data := NewData, + timer := Timer, + hibernate := Hibernate, + postponed := P}, + Q, Timer); +loop_event_actions( + Parent, Debug, S, Events, Event, State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, [Action|Actions]) -> + case Action of + %% Set options postpone -> - collect_transition_options( - Ops, true, Hibernate, Timeout, Actions); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + true, Hibernate, Timeout, NextEvents, Actions); {postpone,NewPostpone} when is_boolean(NewPostpone) -> - collect_transition_options( - Ops, NewPostpone, Hibernate, Timeout, Actions); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + NewPostpone, Hibernate, Timeout, NextEvents, Actions); {postpone,_} -> - [error,{bad_ops,AllOps},?STACKTRACE()]; + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); hibernate -> - collect_transition_options( - Ops, Postpone, true, Timeout, Actions); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, true, Timeout, NextEvents, Actions); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - collect_transition_options( - Ops, Postpone, NewHibernate, Timeout, Actions); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, NewHibernate, Timeout, NextEvents, Actions); {hibernate,_} -> - [error,{bad_ops,AllOps},?STACKTRACE()]; - {timeout,infinity,_} -> % Ignore since it will never time out - collect_transition_options( - Ops, Postpone, Hibernate, undefined, Actions); + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); + {timeout,infinity,_} -> % Clear timer - it will never trigger + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, undefined, NextEvents, Actions); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> - collect_transition_options( - Ops, Postpone, Hibernate, NewTimeout, Actions); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, NewTimeout, NextEvents, Actions); {timeout,_,_} -> - [error,{bad_ops,AllOps},?STACKTRACE()]; - _ -> % Collect others as actions - collect_transition_options( - Ops, Postpone, Hibernate, Timeout, [Op|Actions]) - end. - -process_transition_actions([], Debug, _S, Q, P) -> - {Debug,Q,P}; -process_transition_actions( - [Action|Actions] = AllActions, Debug, S, Q, P) -> - case Action of - {reply,{_To,_Tag}=Caller,Reply} -> - NewDebug = do_reply(Debug, S, Caller, Reply), - process_transition_actions(Actions, NewDebug, S, Q, P); + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); + %% Actual actions + {reply,Caller,Reply} -> + case caller(Caller) of + true -> + NewDebug = do_reply(Debug, S, Caller, Reply), + loop_event_actions( + Parent, NewDebug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, Actions); + false -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; {next_event,Type,Content} -> case event_type(Type) of true -> - process_transition_actions( - Actions, Debug, S, [{Type,Content}|Q], P); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, + [{Type,Content}|NextEvents], Actions); false -> - [error,{bad_ops,AllActions},?STACKTRACE(),Debug] + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) end; _ -> %% All others are remove actions case remove_fun(Action) of false -> - process_transition_actions( - Actions, Debug, S, Q, P); + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, Actions); undefined -> - [error,{bad_ops,AllActions},?STACKTRACE(),Debug]; + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); RemoveFun when is_function(RemoveFun, 2) -> - case remove_event(RemoveFun, Q, P) of - {NewQ,NewP} -> - process_transition_actions( - Actions, Debug, S, NewQ, NewP); - Error -> - Error ++ [Debug] + #{postponed := P} = S, + case remove_event(RemoveFun, Events, P) of + false -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, + Actions); + {NewEvents,false} -> + loop_event_actions( + Parent, Debug, S, NewEvents, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, + Actions); + {false,NewP} -> + NewS = S#{postponed := NewP}, + loop_event_actions( + Parent, Debug, NewS, Events, Event, + State, NewState, NewData, + Postpone, Hibernate, Timeout, NextEvents, + Actions); + [Class,Reason,Stacktrace] -> + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events]) end; - Error -> - Error ++ [Debug] + [Class,Reason,Stacktrace] -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end end. +%%--------------------------------------------------------------------------- +%% Server helpers + reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> if is_list(Replies) -> @@ -1004,14 +1068,14 @@ reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs] = Replies) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> case R of {reply,{_To,_Tag}=Caller,Reply} -> NewDebug = do_reply(Debug, S, Caller, Reply), do_reply_then_terminate( Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> - [error,{bad_replies,Replies},?STACKTRACE(),Debug] + [error,{bad_action,R},?STACKTRACE(),Debug] end. do_reply(Debug, S, Caller, Reply) -> @@ -1026,20 +1090,19 @@ remove_event(RemoveFun, Q, P) -> false -> case remove_head_event(RemoveFun, Q) of false -> - {P,Q}; + false; NewQ -> - {P,NewQ} + {false,NewQ} end; NewP -> - {NewP,Q} + {NewP,false} end catch Class:Reason -> [Class,Reason,erlang:get_stacktrace()] end. -%% Do the given transition action and create -%% an event removal predicate fun() +%% Do the given action and create an event removal predicate fun() remove_fun({remove_event,Type,Content}) -> fun (T, C) when T =:= Type, C =:= Content -> true; (_, _) -> false -- cgit v1.2.3 From 14028aee428c135211e33df77c1bee2fdc128f6e Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 24 Feb 2016 16:36:24 +0100 Subject: Ditch PrevState StateName/4 -> StateName/3 handle_event/5 -> handle_event/4 --- lib/stdlib/src/gen_statem.erl | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7fbc1e0f0d..c844b76653 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -184,7 +184,6 @@ -callback state_name( event_type(), EventContent :: term(), - PrevStateName :: state_name(), % Previous state name Data :: data()) -> state_callback_result(). %% @@ -195,7 +194,6 @@ -callback handle_event( event_type(), EventContent :: term(), - PrevState :: state(), % Previous state State :: state(), % Current state Data :: data()) -> state_callback_result(). @@ -234,10 +232,10 @@ [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation %% - state_name/4, % Example for callback_mode =:= state_functions: + state_name/3, % Example for callback_mode =:= state_functions: %% there has to be a StateName/5 callback function for every StateName. %% - handle_event/5]). % For callback_mode =:= handle_event_function + handle_event/4]). % For callback_mode =:= handle_event_function %% Type validation functions callback_mode(CallbackMode) -> @@ -518,7 +516,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) true -> Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - PrevState = undefined, + OldState = make_ref(), NewActions = if is_list(Actions) -> @@ -530,8 +528,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) callback_mode => CallbackMode, module => Module, name => Name, - prev_state => PrevState, - state => PrevState, % Discarded by loop_event_actions + state => OldState, % Discarded by loop_event_actions data => Data, timer => undefined, postponed => [], @@ -539,7 +536,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) loop_event_actions( Parent, Debug, S, [], {event,undefined}, % Discarded due to {postpone,false} - PrevState, State, Data, NewActions); + OldState, State, Data, NewActions); false -> erlang:error( badarg, @@ -771,7 +768,6 @@ loop_events( Parent, Debug, #{callback_mode := CallbackMode, module := Module, - prev_state := PrevState, state := State, data := Data} = S, [{Type,Content} = Event|Events] = Q, Timer) -> @@ -780,9 +776,9 @@ loop_events( try case CallbackMode of state_functions -> - Module:State(Type, Content, PrevState, Data); + Module:State(Type, Content, Data); handle_event_function -> - Module:handle_event(Type, Content, PrevState, State, Data) + Module:handle_event(Type, Content, State, Data) end of Result -> loop_event_result( @@ -796,7 +792,7 @@ loop_events( %% of calling a nonexistent state function case erlang:get_stacktrace() of [{Module,State, - [Type,Content,PrevState,Data]=Args, + [Type,Content,Data]=Args, _} |Stacktrace] when CallbackMode =:= state_functions -> @@ -806,7 +802,7 @@ loop_events( Stacktrace, Debug, S, Q); [{Module,handle_event, - [Type,Content,PrevState,State,Data]=Args, + [Type,Content,State,Data]=Args, _} |Stacktrace] when CallbackMode =:= handle_event_function -> @@ -932,7 +928,6 @@ loop_event_actions( loop_events( Parent, NewDebug, S#{ - prev_state := State, state := NewState, data := NewData, timer := Timer, -- cgit v1.2.3 From e1bbf6f1a081ff41d3287a468450bef5f65ea4ad Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Wed, 24 Feb 2016 17:04:30 +0100 Subject: Type check in API --- lib/stdlib/src/gen_statem.erl | 104 ++++++++++++++++++++++++------------------ 1 file changed, 60 insertions(+), 44 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index c844b76653..dd980daddb 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -487,8 +487,17 @@ enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> Actions :: [action()] | action()) -> no_return(). enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> - Parent = gen:get_parent(), - enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). + case is_atom(Module) andalso callback_mode(CallbackMode) of + true -> + Parent = gen:get_parent(), + enter( + Module, Opts, CallbackMode, State, Data, Server, + Actions, Parent); + false -> + error( + badarg, + [Module,Opts,CallbackMode,State,Data,Server,Actions]) + end. %%--------------------------------------------------------------------------- %% API helpers @@ -510,38 +519,31 @@ do_send(Proc, Msg) -> end. %% Here init_it/6 and enter_loop/5,6,7 functions converge -enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) - when is_atom(Module), is_pid(Parent) -> - case callback_mode(CallbackMode) of - true -> - Name = gen:get_proc_name(Server), - Debug = gen:debug_options(Name, Opts), - OldState = make_ref(), - NewActions = - if - is_list(Actions) -> - Actions ++ [{postpone,false}]; - true -> - [Actions,{postpone,false}] - end, - S = #{ - callback_mode => CallbackMode, - module => Module, - name => Name, - state => OldState, % Discarded by loop_event_actions - data => Data, - timer => undefined, - postponed => [], - hibernate => false}, - loop_event_actions( - Parent, Debug, S, [], - {event,undefined}, % Discarded due to {postpone,false} - OldState, State, Data, NewActions); - false -> - erlang:error( - badarg, - [Module,Opts,CallbackMode,State,Data,Server,Actions,Parent]) - end. +enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> + %% The values should already have been type checked + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Opts), + OldState = make_ref(), % Will be discarded by loop_event_actions/9 + NewActions = + if + is_list(Actions) -> + Actions ++ [{postpone,false}]; + true -> + [Actions,{postpone,false}] + end, + S = #{ + callback_mode => CallbackMode, + module => Module, + name => Name, + state => OldState, + data => Data, + timer => undefined, + postponed => [], + hibernate => false}, + loop_event_actions( + Parent, Debug, S, [], + {event,undefined}, % Will be discarded thanks to {postpone,false} + OldState, State, Data, NewActions). %%%========================================================================== %%% gen callbacks @@ -567,15 +569,29 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of {CallbackMode,State,Data} -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, [], Parent); + case callback_mode(CallbackMode) of + true -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, [], Parent); + false -> + Error = {bad_return_value,Result}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end; {CallbackMode,State,Data,Actions} -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, Actions, Parent); + case callback_mode(CallbackMode) of + true -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, Actions, Parent); + false -> + Error = {bad_return_value,Result}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end; {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -584,8 +600,8 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, ignore), exit(normal); - Other -> - Error = {bad_return_value,Other}, + _ -> + Error = {bad_return_value,Result}, proc_lib:init_ack(Starter, {error,Error}), exit(Error) end. -- cgit v1.2.3 From edc94441562b255467773ec27b11835910a708fd Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 25 Feb 2016 15:12:48 +0100 Subject: Remove {keep_state_and_data} MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Correct typo reported by Luïc Hoguin. --- lib/stdlib/src/gen_statem.erl | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index dd980daddb..e6ad7ab0be 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -156,11 +156,10 @@ Actions :: [action()] | action()} | {'keep_state', % {keep_state,NewData,[]} NewData :: data()} | - {'keep_state', + {'keep_state', % Keep state, change data NewData :: data(), Actions :: [action()] | action()} | - {'keep_state_and_data'} | % {keep_state_and_data,[]} - {'keep_state_and_data', + {'keep_state_and_data', % Keep state and data -> only actions Actions :: [action()] | action()}. @@ -880,10 +879,6 @@ loop_event_result( loop_event_actions( Parent, Debug, S, Events, Event, State, State, NewData, Actions); - {keep_state_and_data} -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, Data, []); {keep_state_and_data,Actions} -> loop_event_actions( Parent, Debug, S, Events, Event, -- cgit v1.2.3 From 1e4831762b5ab4bd2210fc9e0a204e00dfe81b39 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 26 Feb 2016 10:35:16 +0100 Subject: Implement 'keep_state_and_data' and 'stop' --- lib/stdlib/src/gen_statem.erl | 60 ++++++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 26 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index e6ad7ab0be..16c296794f 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -135,32 +135,34 @@ Caller :: caller(), Reply :: term()}. -type state_callback_result() :: - {'stop', % Stop the server - Reason :: term()} | - {'stop', % Stop the server - Reason :: term(), - NewData :: data()} | - {'stop_and_reply', % Reply then stop the server - Reason :: term(), - Replies :: [reply_action()] | reply_action()} | - {'stop_and_reply', % Reply then stop the server - Reason :: term(), - Replies :: [reply_action()] | reply_action(), - NewData :: data()} | - {'next_state', % {next_state,NewState,NewData,[]} - NewState :: state(), - NewData :: data()} | - {'next_state', % State transition, maybe to the same state - NewState :: state(), - NewData :: data(), - Actions :: [action()] | action()} | - {'keep_state', % {keep_state,NewData,[]} - NewData :: data()} | - {'keep_state', % Keep state, change data - NewData :: data(), - Actions :: [action()] | action()} | - {'keep_state_and_data', % Keep state and data -> only actions - Actions :: [action()] | action()}. + 'stop' | % {stop,normal} + {'stop', % Stop the server + Reason :: term()} | + {'stop', % Stop the server + Reason :: term(), + NewData :: data()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action(), + NewData :: data()} | + {'next_state', % {next_state,NewState,NewData,[]} + NewState :: state(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NewState :: state(), + NewData :: data(), + Actions :: [action()] | action()} | + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [action()] | action()} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [action()] | action()}. %% The state machine init function. It is called only once and @@ -841,6 +843,8 @@ loop_event_result( #{state := State, data := Data} = S, Events, Event, Result) -> case Result of + stop -> + ?TERMINATE(exit, normal, Debug, S, [Event|Events]); {stop,Reason} -> ?TERMINATE(exit, Reason, Debug, S, [Event|Events]); {stop,Reason,NewData} -> @@ -879,6 +883,10 @@ loop_event_result( loop_event_actions( Parent, Debug, S, Events, Event, State, State, NewData, Actions); + keep_state_and_data -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, State, Data, []); {keep_state_and_data,Actions} -> loop_event_actions( Parent, Debug, S, Events, Event, -- cgit v1.2.3 From efda33e83f2bbc666f6ec261d54ad95c38acbc36 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 26 Feb 2016 10:51:53 +0100 Subject: Allow actions without containing list Type check atom state as early as possible --- lib/stdlib/src/gen_statem.erl | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 16c296794f..83de4114a7 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -571,7 +571,9 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of {CallbackMode,State,Data} -> case callback_mode(CallbackMode) of - true -> + true + when CallbackMode =:= state_functions, is_atom(State); + CallbackMode =/= state_functions -> proc_lib:init_ack(Starter, {ok,self()}), enter( Module, Opts, CallbackMode, State, Data, @@ -840,7 +842,7 @@ loop_events( %% Interpret all callback return value variants loop_event_result( Parent, Debug, - #{state := State, data := Data} = S, + #{callback_mode := CallbackMode, state := State, data := Data} = S, Events, Event, Result) -> case Result of stop -> @@ -866,12 +868,15 @@ loop_event_result( exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); - {next_state,NewState,NewData} -> + {next_state,NewState,NewData} + when CallbackMode =:= state_functions, is_atom(NewState); + CallbackMode =/= state_functions -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, []); {next_state,NewState,NewData,Actions} - when is_list(Actions) -> + when CallbackMode =:= state_functions, is_atom(NewState); + CallbackMode =/= state_functions -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions); @@ -900,7 +905,13 @@ loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions) -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, - false, false, undefined, [], Actions). + false, false, undefined, [], + if + is_list(Actions) -> + Actions; + true -> + [Actions] + end). %% loop_event_actions( Parent, Debug, #{postponed := P0} = S, Events, Event, -- cgit v1.2.3 From 07790dfcd4c5706878e8562365e2418021e67056 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 26 Feb 2016 11:58:47 +0100 Subject: Optimize postponed handling --- lib/stdlib/src/gen_statem.erl | 187 +++++++++++++++++++++++------------------- 1 file changed, 101 insertions(+), 86 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 83de4114a7..8f058cc3a8 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -903,108 +903,63 @@ loop_event_result( loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions) -> + Postpone = false, % Shall we postpone this event, true or false + Hibernate = false, + Timeout = undefined, + NextEvents = [], + P = false, % The postponed list or false if unchanged loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, - false, false, undefined, [], if is_list(Actions) -> Actions; true -> [Actions] - end). + end, + Postpone, Hibernate, Timeout, NextEvents, P). %% loop_event_actions( - Parent, Debug, #{postponed := P0} = S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, []) -> - P1 = % Move current event to postponed if Postpone - case Postpone of - true -> - [Event|P0]; - false -> - P0 - end, - {Timer,Q1} = - case Timeout of - undefined -> - {undefined,Events}; - {timeout,0,Msg} -> - %% Pretend the timeout has just been received - {undefined,Events ++ [{timeout,Msg}]}; - {timeout,Time,Msg} -> - {erlang:start_timer(Time, self(), Msg), - Events} - end, - {Q2,P} = % Move all postponed events to queue if state change - if - NewState =:= State -> - {Q1,P1}; - true -> - {lists:reverse(P1, Q1),[]} - end, - %% Place next events first in queue - Q = lists:reverse(NextEvents, Q2), - %% - NewDebug = - sys_debug( - Debug, S, - case Postpone of - true -> - {postpone,Event,NewState}; - false -> - {consume,Event,NewState} - end), - %% Loop to top; process next event - loop_events( - Parent, NewDebug, - S#{ - state := NewState, - data := NewData, - timer := Timer, - hibernate := Hibernate, - postponed := P}, - Q, Timer); -loop_event_actions( - Parent, Debug, S, Events, Event, State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, [Action|Actions]) -> + Parent, Debug, S, Events, Event, + State, NewState, NewData, [Action|Actions], + Postpone, Hibernate, Timeout, NextEvents, P) -> case Action of %% Set options postpone -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - true, Hibernate, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + true, Hibernate, Timeout, NextEvents, P); {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - NewPostpone, Hibernate, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + NewPostpone, Hibernate, Timeout, NextEvents, P); {postpone,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); hibernate -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, true, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, true, Timeout, NextEvents, P); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, NewHibernate, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, NewHibernate, Timeout, NextEvents, P); {hibernate,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); {timeout,infinity,_} -> % Clear timer - it will never trigger loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, undefined, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, undefined, NextEvents, P); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, NewTimeout, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, NewTimeout, NextEvents, P); {timeout,_,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -1015,8 +970,8 @@ loop_event_actions( NewDebug = do_reply(Debug, S, Caller, Reply), loop_event_actions( Parent, NewDebug, S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents, P); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) @@ -1026,9 +981,9 @@ loop_event_actions( true -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, + State, NewState, NewData, Actions, Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents], Actions); + [{Type,Content}|NextEvents], P); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) @@ -1039,33 +994,36 @@ loop_event_actions( false -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents, P); undefined -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); RemoveFun when is_function(RemoveFun, 2) -> - #{postponed := P} = S, - case remove_event(RemoveFun, Events, P) of + P0 = + case P of + false -> + maps:get(postponed, S); + _ -> + P + end, + case remove_event(RemoveFun, Events, P0) of false -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, - Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents, P); {NewEvents,false} -> loop_event_actions( Parent, Debug, S, NewEvents, Event, - State, NewState, NewData, - Postpone, Hibernate, Timeout, NextEvents, - Actions); + State, NewState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents, P); {false,NewP} -> - NewS = S#{postponed := NewP}, loop_event_actions( - Parent, Debug, NewS, Events, Event, - State, NewState, NewData, + Parent, Debug, S, Events, Event, + State, NewState, NewData, Actions, Postpone, Hibernate, Timeout, NextEvents, - Actions); + NewP); [Class,Reason,Stacktrace] -> terminate( Class, Reason, Stacktrace, @@ -1075,7 +1033,64 @@ loop_event_actions( terminate( Class, Reason, Stacktrace, Debug, S, [Event|Events]) end - end. + end; +loop_event_actions( + Parent, Debug, S, Events, Event, State, NewState, NewData, [], + Postpone, Hibernate, Timeout, NextEvents, P) -> + P0 = + case P of + false -> + maps:get(postponed, S); + _ -> + P + end, + P1 = % Move current event to postponed if Postpone + case Postpone of + true -> + [Event|P0]; + false -> + P0 + end, + {Timer,Q1} = + case Timeout of + undefined -> + {undefined,Events}; + {timeout,0,Msg} -> + %% Pretend the timeout has just been received + {undefined,Events ++ [{timeout,Msg}]}; + {timeout,Time,Msg} -> + {erlang:start_timer(Time, self(), Msg), + Events} + end, + {Q2,P2} = % Move all postponed events to queue if state change + if + NewState =:= State -> + {Q1,P1}; + true -> + {lists:reverse(P1, Q1),[]} + end, + %% Place next events first in queue + Q3 = lists:reverse(NextEvents, Q2), + %% + NewDebug = + sys_debug( + Debug, S, + case Postpone of + true -> + {postpone,Event,NewState}; + false -> + {consume,Event,NewState} + end), + %% Loop to top; process next event + loop_events( + Parent, NewDebug, + S#{ + state := NewState, + data := NewData, + timer := Timer, + hibernate := Hibernate, + postponed := P2}, + Q3, Timer). %%--------------------------------------------------------------------------- %% Server helpers -- cgit v1.2.3 From c2b8e6cdbc884e93cabe78e9fc9dcc040eb828eb Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 26 Feb 2016 16:19:55 +0100 Subject: Relax caller() type check and cleanup --- lib/stdlib/src/gen_statem.erl | 56 ++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 27 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 8f058cc3a8..29848d13a3 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -249,7 +249,7 @@ callback_mode(CallbackMode) -> false end. %% -caller({Pid,Tag}) when is_pid(Pid), is_reference(Tag) -> +caller({Pid,_}) when is_pid(Pid) -> true; caller(_) -> false. @@ -279,7 +279,7 @@ event_type(Type) -> -define( TERMINATE(Class, Reason, Debug, S, Q), terminate( - Class, + begin Class end, begin Reason end, ?STACKTRACE(), begin Debug end, @@ -355,23 +355,23 @@ stop(ServerRef, Reason, Timeout) -> %% Send an event to a state machine that arrives with type 'event' -spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. cast({global,Name}, Msg) -> - try global:send(Name, cast(Msg)) of + try global:send(Name, wrap_cast(Msg)) of _ -> ok catch _:_ -> ok end; cast({via,RegMod,Name}, Msg) -> - try RegMod:send(Name, cast(Msg)) of + try RegMod:send(Name, wrap_cast(Msg)) of _ -> ok catch _:_ -> ok end; cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> - do_send(ServerRef, cast(Msg)); + send(ServerRef, wrap_cast(Msg)); cast(ServerRef, Msg) when is_atom(ServerRef) -> - do_send(ServerRef, cast(Msg)); + send(ServerRef, wrap_cast(Msg)); cast(ServerRef, Msg) when is_pid(ServerRef) -> - do_send(ServerRef, cast(Msg)). + send(ServerRef, wrap_cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that %% arrives with type {call,Caller} @@ -425,7 +425,7 @@ call(ServerRef, Request, Timeout) -> {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, Stacktrace); {'DOWN',Mref,_,_,Reason} -> - %% There is just a theoretical possibility that the + %% There is a theoretical possibility that the %% proxy process gets killed between try--of and ! %% so this clause is in case of that exit(Reason) @@ -433,14 +433,13 @@ call(ServerRef, Request, Timeout) -> %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. -reply({reply,{_To,_Tag}=Caller,Reply}) -> +reply({reply,Caller,Reply}) -> reply(Caller, Reply); reply(Replies) when is_list(Replies) -> - [reply(Reply) || Reply <- Replies], - ok. + replies(Replies). %% -spec reply(Caller :: caller(), Reply :: term()) -> ok. -reply({To,Tag}, Reply) -> +reply({To,Tag}, Reply) when is_pid(To) -> Msg = {Tag,Reply}, try To ! Msg of _ -> @@ -503,11 +502,17 @@ enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> %%--------------------------------------------------------------------------- %% API helpers -cast(Event) -> +wrap_cast(Event) -> {'$gen_cast',Event}. +replies([{reply,Caller,Reply}|Replies]) -> + reply(Caller, Reply), + replies(Replies); +replies([]) -> + ok. + %% Might actually not send the message in case of caught exception -do_send(Proc, Msg) -> +send(Proc, Msg) -> try erlang:send(Proc, Msg, [noconnect]) of noconnect -> _ = spawn(erlang, send, [Proc,Msg]), @@ -723,20 +728,17 @@ wakeup_from_hibernate(Parent, Debug, S) -> loop(Parent, Debug, #{hibernate := Hib} = S) -> case Hib of true -> - loop_hibernate(Parent, Debug, S); + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}); false -> loop_receive(Parent, Debug, S) end. -loop_hibernate(Parent, Debug, S) -> - %% Does not return but restarts process at - %% wakeup_from_hibernate/3 that jumps to loop_receive/3 - proc_lib:hibernate( - ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), - error( - {should_not_have_arrived_here_but_instead_in, - {wakeup_from_hibernate,3}}). - %% Entry point for wakeup_from_hibernate/3 loop_receive(Parent, Debug, #{timer := Timer} = S) -> receive @@ -754,7 +756,7 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> %% but this will stand out in the crash report... ?TERMINATE(exit, Reason, Debug, S, [EXIT]); {timeout,Timer,Content} when Timer =/= undefined -> - loop_receive( + loop_event( Parent, Debug, S, {timeout,Content}, undefined); _ -> Event = @@ -766,11 +768,11 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_receive(Parent, Debug, S, Event, Timer) + loop_event(Parent, Debug, S, Event, Timer) end end. -loop_receive(Parent, Debug, S, Event, Timer) -> +loop_event(Parent, Debug, S, Event, Timer) -> NewDebug = sys_debug(Debug, S, {in,Event}), %% Here the queue of not yet processed events is created loop_events(Parent, NewDebug, S, [Event], Timer). -- cgit v1.2.3 From e660572b020da58c89149c7f052c7127cc0263cb Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 29 Feb 2016 11:36:27 +0100 Subject: Remove the remove_event action and all alike Removing events from the internal queues is not necessary with the choosen semantics of the event queue vs. hibernate. In an early implementation it was possible by combining hibernate with e.g. postpone to get an event in the queue that you would not see before processing the postponed event, and therefore should you decide to cancel a timer it was essential to be able to remove that unseen event from the queue. With the choosen semantics you will have to postpone or generate an event for it to be in the event queue, and if you e.g. postpone a timeout event and then cancel the timer it is your mistake. You have seen the event and should know better than to try to cancel the timer. So, the actions: remove_event, cancel_timer, demonitor and unlink are now removed. There have also been some cleanup of the timer handling code. --- lib/stdlib/src/gen_statem.erl | 326 +++++++++++------------------------------- 1 file changed, 86 insertions(+), 240 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 29848d13a3..26f1aede6f 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -66,9 +66,6 @@ {'call',Caller :: caller()} | 'cast' | 'info' | 'timeout' | 'internal'. --type event_predicate() :: % Return true for the event in question - fun((event_type(), term()) -> boolean()). - -type callback_mode() :: 'state_functions' | 'handle_event_function'. -type transition_option() :: @@ -117,19 +114,7 @@ %% action() list is the first to be delivered. {'next_event', % Insert event as the next to handle EventType :: event_type(), - EventContent :: term()} | - %% - {'remove_event', % Remove the oldest matching (=:=) event - EventType :: event_type(), EventContent :: term()} | - {'remove_event', % Remove the oldest event satisfying predicate - EventPredicate :: event_predicate()} | - %% - {'cancel_timer', % Cancel timer and clean up mess(ages) - TimerRef :: reference()} | - {'demonitor', % Demonitor and clean up mess(ages) - MonitorRef :: reference()} | - {'unlink', % Unlink and clean up mess(ages) - Id :: pid() | port()}. + EventContent :: term()}. -type reply_action() :: {'reply', % Reply to a caller Caller :: caller(), Reply :: term()}. @@ -745,11 +730,11 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> Msg -> case Msg of {system,Pid,Req} -> + #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, - maps:get(hibernate, S)); + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), @@ -757,8 +742,25 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> ?TERMINATE(exit, Reason, Debug, S, [EXIT]); {timeout,Timer,Content} when Timer =/= undefined -> loop_event( - Parent, Debug, S, {timeout,Content}, undefined); + Parent, Debug, S, {timeout,Content}); _ -> + %% Cancel Timer if running + case Timer of + undefined -> + ok; + _ -> + case erlang:cancel_timer(Timer) of + TimeLeft when is_integer(TimeLeft) -> + ok; + false -> + receive + {timeout,Timer,_} -> + ok + after 0 -> + ok + end + end + end, Event = case Msg of {'$gen_call',Caller,Request} -> @@ -768,22 +770,20 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_event(Parent, Debug, S, Event, Timer) + loop_event(Parent, Debug, S, Event) end end. -loop_event(Parent, Debug, S, Event, Timer) -> +loop_event(Parent, Debug, S, Event) -> + %% The timer field in S is now invalid and ignored + %% until we get back to loop/3 NewDebug = sys_debug(Debug, S, {in,Event}), %% Here the queue of not yet processed events is created - loop_events(Parent, NewDebug, S, [Event], Timer). + loop_events(Parent, NewDebug, S, [Event]). -%% Process first event in queue, or if there is none receive a new -%% -%% The loop_event* functions optimize S map handling by dismantling it, -%% passing the parts in arguments to avoid map lookups and construct the -%% new S map in one go on exit. Premature optimization, I know, but -%% there were quite some map lookups repeated in different functions. -loop_events(Parent, Debug, S, [], _Timer) -> +%% Process first the event queue, or if it is empty +%% loop back to receive a new event +loop_events(Parent, Debug, S, []) -> loop(Parent, Debug, S); loop_events( Parent, Debug, @@ -791,9 +791,7 @@ loop_events( module := Module, state := State, data := Data} = S, - [{Type,Content} = Event|Events] = Q, Timer) -> - _ = (Timer =/= undefined) andalso - cancel_timer(Timer), + [{Type,Content} = Event|Events] = Q) -> try case CallbackMode of state_functions -> @@ -841,7 +839,7 @@ loop_events( terminate(Class, Reason, Stacktrace, Debug, S, Q) end. -%% Interpret all callback return value variants +%% Interpret all callback return variants loop_event_result( Parent, Debug, #{callback_mode := CallbackMode, state := State, data := Data} = S, @@ -909,7 +907,6 @@ loop_event_actions( Hibernate = false, Timeout = undefined, NextEvents = [], - P = false, % The postponed list or false if unchanged loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, if @@ -918,24 +915,25 @@ loop_event_actions( true -> [Actions] end, - Postpone, Hibernate, Timeout, NextEvents, P). + Postpone, Hibernate, Timeout, NextEvents). %% +%% Process all action()s loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, [Action|Actions], - Postpone, Hibernate, Timeout, NextEvents, P) -> + Postpone, Hibernate, Timeout, NextEvents) -> case Action of - %% Set options + %% Actions that set options postpone -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - true, Hibernate, Timeout, NextEvents, P); + true, Hibernate, Timeout, NextEvents); {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - NewPostpone, Hibernate, Timeout, NextEvents, P); + NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -943,12 +941,12 @@ loop_event_actions( loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, true, Timeout, NextEvents, P); + Postpone, true, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, NewHibernate, Timeout, NextEvents, P); + Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -956,12 +954,12 @@ loop_event_actions( loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, undefined, NextEvents, P); + Postpone, Hibernate, undefined, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, NewTimeout, NextEvents, P); + Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); @@ -973,7 +971,7 @@ loop_event_actions( loop_event_actions( Parent, NewDebug, S, Events, Event, State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); + Postpone, Hibernate, Timeout, NextEvents); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) @@ -985,67 +983,25 @@ loop_event_actions( Parent, Debug, S, Events, Event, State, NewState, NewData, Actions, Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents], P); + [{Type,Content}|NextEvents]); false -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) end; _ -> - %% All others are remove actions - case remove_fun(Action) of - false -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - undefined -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); - RemoveFun when is_function(RemoveFun, 2) -> - P0 = - case P of - false -> - maps:get(postponed, S); - _ -> - P - end, - case remove_event(RemoveFun, Events, P0) of - false -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - {NewEvents,false} -> - loop_event_actions( - Parent, Debug, S, NewEvents, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, P); - {false,NewP} -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents, - NewP); - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, - Debug, S, [Event|Events]) - end; - [Class,Reason,Stacktrace] -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) end; +%% +%% End of actions list loop_event_actions( - Parent, Debug, S, Events, Event, State, NewState, NewData, [], - Postpone, Hibernate, Timeout, NextEvents, P) -> - P0 = - case P of - false -> - maps:get(postponed, S); - _ -> - P - end, + Parent, Debug, #{postponed := P0} = S, Events, Event, + State, NewState, NewData, [], + Postpone, Hibernate, Timeout, NextEvents) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% P1 = % Move current event to postponed if Postpone case Postpone of true -> @@ -1053,23 +1009,12 @@ loop_event_actions( false -> P0 end, - {Timer,Q1} = - case Timeout of - undefined -> - {undefined,Events}; - {timeout,0,Msg} -> - %% Pretend the timeout has just been received - {undefined,Events ++ [{timeout,Msg}]}; - {timeout,Time,Msg} -> - {erlang:start_timer(Time, self(), Msg), - Events} - end, - {Q2,P2} = % Move all postponed events to queue if state change + {Q2,P} = % Move all postponed events to queue if state change if NewState =:= State -> - {Q1,P1}; + {Events,P1}; true -> - {lists:reverse(P1, Q1),[]} + {lists:reverse(P1, Events),[]} end, %% Place next events first in queue Q3 = lists:reverse(NextEvents, Q2), @@ -1083,16 +1028,41 @@ loop_event_actions( false -> {consume,Event,NewState} end), - %% Loop to top; process next event + %% Have a peek on the event queue so we can avoid starting + %% the state timer unless we have to + {Q,Timer} = + case Timeout of + undefined -> + %% No state timeout has been requested + {Q3,undefined}; + {timeout,Time,Msg} -> + %% A state timeout has been requested + case Q3 of + [] when Time =:= 0 -> + %% Immediate timeout - simulate it + %% so we do not get the timeout message + %% after any received event + {[{timeout,Msg}],undefined}; + [] -> + %% Actually start a timer + {Q3,erlang:start_timer(Time, self(), Msg)}; + _ -> + %% Do not start a timer since any queued + %% event cancels the state timer so we pretend + %% that the timer has been started and cancelled + {Q3,undefined} + end + end, + %% Loop to top of event queue loop; process next event loop_events( Parent, NewDebug, S#{ state := NewState, data := NewData, timer := Timer, - hibernate := Hibernate, - postponed := P2}, - Q3, Timer). + postponed := P, + hibernate := Hibernate}, + Q). %%--------------------------------------------------------------------------- %% Server helpers @@ -1125,103 +1095,6 @@ do_reply(Debug, S, Caller, Reply) -> sys_debug(Debug, S, {out,Reply,Caller}). -%% Remove oldest matching event from the queue(s) -remove_event(RemoveFun, Q, P) -> - try - case remove_tail_event(RemoveFun, P) of - false -> - case remove_head_event(RemoveFun, Q) of - false -> - false; - NewQ -> - {false,NewQ} - end; - NewP -> - {NewP,false} - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end. - -%% Do the given action and create an event removal predicate fun() -remove_fun({remove_event,Type,Content}) -> - fun (T, C) when T =:= Type, C =:= Content -> true; - (_, _) -> false - end; -remove_fun({remove_event,RemoveFun}) when is_function(RemoveFun, 2) -> - RemoveFun; -remove_fun({cancel_timer,TimerRef}) -> - try cancel_timer(TimerRef) of - false -> - false; - true -> - fun - (info, {timeout,TRef,_}) - when TRef =:= TimerRef -> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun({demonitor,MonitorRef}) -> - try erlang:demonitor(MonitorRef, [flush,info]) of - false -> - false; - true -> - fun (info, {'DOWN',MRef,_,_,_}) - when MRef =:= MonitorRef-> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun({unlink,Id}) -> - try unlink(Id) of - true -> - receive - {'EXIT',Id,_} -> - ok - after 0 -> - ok - end, - fun (info, {'EXIT',I,_}) - when I =:= Id -> - true; - (_, _) -> - false - end - catch - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] - end; -remove_fun(_) -> - undefined. - - -%% Cancel a timer and clense the process mailbox returning -%% false if no such timer message can arrive after this or -%% true otherwise -cancel_timer(TimerRef) -> - case erlang:cancel_timer(TimerRef) of - TimeLeft when is_integer(TimeLeft) -> - false; - false -> - receive - {timeout,TimerRef,_} -> - false - after 0 -> - true - end - end. - - terminate( Class, Reason, Stacktrace, Debug, #{module := Module, @@ -1350,30 +1223,3 @@ format_status_default(Opt, State, Data) -> _ -> [{data,[{"State",SSD}]}] end. - -%%--------------------------------------------------------------------------- -%% Farily general helpers - -%% Return the modified list where the first element that satisfies -%% the RemoveFun predicate is removed, or false if no such element exists. -remove_head_event(_RemoveFun, []) -> - false; -remove_head_event(RemoveFun, [{Tag,Content}|Events]) -> - case RemoveFun(Tag, Content) of - false -> - remove_head_event(RemoveFun, Events); - true -> - Events - end. - -%% Return the modified list where the last element that satisfies -%% the RemoveFun predicate is removed, or false if no such element exists. -remove_tail_event(_RemoveFun, []) -> - false; -remove_tail_event(RemoveFun, [{Tag,Content} = Event|Events]) -> - case remove_tail_event(RemoveFun, Events) of - false -> - RemoveFun(Tag, Content) andalso Events; - NewEvents -> - [Event|NewEvents] - end. -- cgit v1.2.3 From 79d75b981274f6841e1d4c09c125f92e1731ab4b Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Mon, 29 Feb 2016 16:10:00 +0100 Subject: Sharpen test suite --- lib/stdlib/src/gen_statem.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 26f1aede6f..17d361efc2 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1169,7 +1169,7 @@ error_info( "** Reason for termination = ~w:~p~n" ++ "** State = ~p~n" ++ "** Callback mode = ~p~n" ++ - "** Queued/Posponed = ~w/~w~n" ++ + "** Queued/Postponed = ~w/~w~n" ++ case FixedStacktrace of [] -> ""; -- cgit v1.2.3 From 9dfb4e6cf574870ac6e6a5a2a507c989c64e7525 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 1 Mar 2016 08:31:58 +0100 Subject: Change code_change/4 to {ok,State,Data} --- lib/stdlib/src/gen_statem.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 17d361efc2..cc09efc140 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -200,7 +200,7 @@ OldState :: state(), OldData :: data(), Extra :: term()) -> - {ok, {NewState :: state(), NewData :: data()}}. + {ok, NewState :: state(), NewData :: data()}. %% Format the callback module state in some sensible that is %% often condensed way. For StatusOption =:= 'normal' the perferred @@ -619,7 +619,7 @@ system_code_change( Result -> Result end of - {ok,{NewState,NewData}} -> + {ok,NewState,NewData} -> {ok, S#{ state := NewState, -- cgit v1.2.3 From d840b24857a1d54419953661f70716c449c11864 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 3 Mar 2016 10:54:01 +0100 Subject: Fix most of the system docs and emacs mode --- lib/stdlib/src/gen_statem.erl | 93 ++++++++++++++++++++++++++----------------- 1 file changed, 56 insertions(+), 37 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index cc09efc140..438c366f8e 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -44,8 +44,16 @@ -export( [wakeup_from_hibernate/3]). +%% Type exports for templates +-export_type( + [event_type/0, + callback_mode/0, + state_function_result/0, + handle_event_result/0, + action/0]). + %% Fix problem for doc build --export_type([transition_option/0,state_callback_result/0]). +-export_type([transition_option/0]). %%%========================================================================== %%% Interface functions. @@ -84,7 +92,7 @@ -type action() :: %% During a state change: - %% * NewState and NewData are set. + %% * NextState and NewData are set. %% * All action()s are executed in order of apperance. %% * Postponing the current event is performed %% iff 'postpone' is 'true'. @@ -119,7 +127,25 @@ {'reply', % Reply to a caller Caller :: caller(), Reply :: term()}. --type state_callback_result() :: +-type state_function_result() :: + {'next_state', % {next_state,NextStateName,NewData,[]} + NextStateName :: state_name(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextStateName :: state_name(), + NewData :: data(), + Actions :: [action()] | action()} | + common_state_callback_result(). +-type handle_event_result() :: + {'next_state', % {next_state,NextState,NewData,[]} + NextState :: state(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextState :: state(), + NewData :: data(), + Actions :: [action()] | action()} | + common_state_callback_result(). +-type common_state_callback_result() :: 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | @@ -133,13 +159,6 @@ Reason :: term(), Replies :: [reply_action()] | reply_action(), NewData :: data()} | - {'next_state', % {next_state,NewState,NewData,[]} - NewState :: state(), - NewData :: data()} | - {'next_state', % State transition, maybe to the same state - NewState :: state(), - NewData :: data(), - Actions :: [action()] | action()} | {'keep_state', % {keep_state,NewData,[]} NewData :: data()} | {'keep_state', % Keep state, change data @@ -171,7 +190,7 @@ event_type(), EventContent :: term(), Data :: data()) -> - state_callback_result(). + state_function_result(). %% %% State callback for callback_mode() =:= handle_event_function. %% @@ -182,7 +201,7 @@ EventContent :: term(), State :: state(), % Current state Data :: data()) -> - state_callback_result(). + handle_event_result(). %% Clean up before the server terminates. -callback terminate( @@ -514,7 +533,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - OldState = make_ref(), % Will be discarded by loop_event_actions/9 + PrevState = make_ref(), % Will be discarded by loop_event_actions/9 NewActions = if is_list(Actions) -> @@ -526,7 +545,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> callback_mode => CallbackMode, module => Module, name => Name, - state => OldState, + state => PrevState, data => Data, timer => undefined, postponed => [], @@ -534,7 +553,7 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> loop_event_actions( Parent, Debug, S, [], {event,undefined}, % Will be discarded thanks to {postpone,false} - OldState, State, Data, NewActions). + PrevState, State, Data, NewActions). %%%========================================================================== %%% gen callbacks @@ -868,18 +887,18 @@ loop_event_result( exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); - {next_state,NewState,NewData} - when CallbackMode =:= state_functions, is_atom(NewState); + {next_state,NextState,NewData} + when CallbackMode =:= state_functions, is_atom(NextState); CallbackMode =/= state_functions -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, []); - {next_state,NewState,NewData,Actions} - when CallbackMode =:= state_functions, is_atom(NewState); + State, NextState, NewData, []); + {next_state,NextState,NewData,Actions} + when CallbackMode =:= state_functions, is_atom(NextState); CallbackMode =/= state_functions -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions); + State, NextState, NewData, Actions); {keep_state,NewData} -> loop_event_actions( Parent, Debug, S, Events, Event, @@ -902,13 +921,13 @@ loop_event_result( end. loop_event_actions( - Parent, Debug, S, Events, Event, State, NewState, NewData, Actions) -> + Parent, Debug, S, Events, Event, State, NextState, NewData, Actions) -> Postpone = false, % Shall we postpone this event, true or false Hibernate = false, Timeout = undefined, NextEvents = [], loop_event_actions( - Parent, Debug, S, Events, Event, State, NewState, NewData, + Parent, Debug, S, Events, Event, State, NextState, NewData, if is_list(Actions) -> Actions; @@ -920,19 +939,19 @@ loop_event_actions( %% Process all action()s loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, [Action|Actions], + State, NextState, NewData, [Action|Actions], Postpone, Hibernate, Timeout, NextEvents) -> case Action of %% Actions that set options postpone -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, true, Hibernate, Timeout, NextEvents); {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> ?TERMINATE( @@ -940,12 +959,12 @@ loop_event_actions( hibernate -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, true, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> ?TERMINATE( @@ -953,12 +972,12 @@ loop_event_actions( {timeout,infinity,_} -> % Clear timer - it will never trigger loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, Hibernate, undefined, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> ?TERMINATE( @@ -970,7 +989,7 @@ loop_event_actions( NewDebug = do_reply(Debug, S, Caller, Reply), loop_event_actions( Parent, NewDebug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, Hibernate, Timeout, NextEvents); false -> ?TERMINATE( @@ -981,7 +1000,7 @@ loop_event_actions( true -> loop_event_actions( Parent, Debug, S, Events, Event, - State, NewState, NewData, Actions, + State, NextState, NewData, Actions, Postpone, Hibernate, Timeout, [{Type,Content}|NextEvents]); false -> @@ -996,7 +1015,7 @@ loop_event_actions( %% End of actions list loop_event_actions( Parent, Debug, #{postponed := P0} = S, Events, Event, - State, NewState, NewData, [], + State, NextState, NewData, [], Postpone, Hibernate, Timeout, NextEvents) -> %% %% All options have been collected and next_events are buffered. @@ -1011,7 +1030,7 @@ loop_event_actions( end, {Q2,P} = % Move all postponed events to queue if state change if - NewState =:= State -> + NextState =:= State -> {Events,P1}; true -> {lists:reverse(P1, Events),[]} @@ -1024,9 +1043,9 @@ loop_event_actions( Debug, S, case Postpone of true -> - {postpone,Event,NewState}; + {postpone,Event,NextState}; false -> - {consume,Event,NewState} + {consume,Event,NextState} end), %% Have a peek on the event queue so we can avoid starting %% the state timer unless we have to @@ -1057,7 +1076,7 @@ loop_event_actions( loop_events( Parent, NewDebug, S#{ - state := NewState, + state := NextState, data := NewData, timer := Timer, postponed := P, -- cgit v1.2.3 From 447f3cf2d041670d93683de4fab02338b26fbaf1 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 3 Mar 2016 11:27:02 +0100 Subject: Rename state_timeout -> event_timeout --- lib/stdlib/src/gen_statem.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 438c366f8e..92e26bd7ed 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -77,7 +77,7 @@ -type callback_mode() :: 'state_functions' | 'handle_event_function'. -type transition_option() :: - postpone() | hibernate() | state_timeout(). + postpone() | hibernate() | event_timeout(). -type postpone() :: %% If 'true' postpone the current event %% and retry it when the state changes (=/=) @@ -85,7 +85,7 @@ -type hibernate() :: %% If 'true' hibernate the server instead of going into receive boolean(). --type state_timeout() :: +-type event_timeout() :: %% Generate a ('timeout', Msg, ...) event after Time %% unless some other event is delivered Time :: timeout(). @@ -111,9 +111,9 @@ 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | %% - (Timeout :: state_timeout()) | % {timeout,Timeout} - {'timeout', % Set the timeout option - Time :: state_timeout(), Msg :: term()} | + (Timeout :: event_timeout()) | % {timeout,Timeout} + {'timeout', % Set the event timeout option + Time :: event_timeout(), Msg :: term()} | %% reply_action() | %% -- cgit v1.2.3 From 2cd331fec3e08799bdd482399e8c969102e1142f Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 17 Mar 2016 16:05:35 +0100 Subject: Change Caller -> From as suggested by Fred Hebert --- lib/stdlib/src/gen_statem.erl | 46 +++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 23 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 92e26bd7ed..82ac5824eb 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -59,7 +59,7 @@ %%% Interface functions. %%%========================================================================== --type caller() :: +-type from() :: {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: @@ -71,7 +71,7 @@ -type data() :: term(). -type event_type() :: - {'call',Caller :: caller()} | 'cast' | + {'call',From :: from()} | 'cast' | 'info' | 'timeout' | 'internal'. -type callback_mode() :: 'state_functions' | 'handle_event_function'. @@ -125,7 +125,7 @@ EventContent :: term()}. -type reply_action() :: {'reply', % Reply to a caller - Caller :: caller(), Reply :: term()}. + From :: from(), Reply :: term()}. -type state_function_result() :: {'next_state', % {next_state,NextStateName,NewData,[]} @@ -253,13 +253,13 @@ callback_mode(CallbackMode) -> false end. %% -caller({Pid,_}) when is_pid(Pid) -> +from({Pid,_}) when is_pid(Pid) -> true; -caller(_) -> +from(_) -> false. %% -event_type({call,Caller}) -> - caller(Caller); +event_type({call,From}) -> + from(From); event_type(Type) -> case Type of cast -> @@ -378,7 +378,7 @@ cast(ServerRef, Msg) when is_pid(ServerRef) -> send(ServerRef, wrap_cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that -%% arrives with type {call,Caller} +%% arrives with type {call,From} -spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). call(ServerRef, Request) -> call(ServerRef, Request, infinity). @@ -437,12 +437,12 @@ call(ServerRef, Request, Timeout) -> %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. -reply({reply,Caller,Reply}) -> - reply(Caller, Reply); +reply({reply,From,Reply}) -> + reply(From, Reply); reply(Replies) when is_list(Replies) -> replies(Replies). %% --spec reply(Caller :: caller(), Reply :: term()) -> ok. +-spec reply(From :: from(), Reply :: term()) -> ok. reply({To,Tag}, Reply) when is_pid(To) -> Msg = {Tag,Reply}, try To ! Msg of @@ -509,8 +509,8 @@ enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> wrap_cast(Event) -> {'$gen_cast',Event}. -replies([{reply,Caller,Reply}|Replies]) -> - reply(Caller, Reply), +replies([{reply,From,Reply}|Replies]) -> + reply(From, Reply), replies(Replies); replies([]) -> ok. @@ -782,8 +782,8 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> end, Event = case Msg of - {'$gen_call',Caller,Request} -> - {{call,Caller},Request}; + {'$gen_call',From,Request} -> + {{call,From},Request}; {'$gen_cast',E} -> {cast,E}; _ -> @@ -983,10 +983,10 @@ loop_event_actions( ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); %% Actual actions - {reply,Caller,Reply} -> - case caller(Caller) of + {reply,From,Reply} -> + case from(From) of true -> - NewDebug = do_reply(Debug, S, Caller, Reply), + NewDebug = do_reply(Debug, S, From, Reply), loop_event_actions( Parent, NewDebug, S, Events, Event, State, NextState, NewData, Actions, @@ -1101,17 +1101,17 @@ do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> do_reply_then_terminate( Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> case R of - {reply,{_To,_Tag}=Caller,Reply} -> - NewDebug = do_reply(Debug, S, Caller, Reply), + {reply,{_To,_Tag}=From,Reply} -> + NewDebug = do_reply(Debug, S, From, Reply), do_reply_then_terminate( Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> [error,{bad_action,R},?STACKTRACE(),Debug] end. -do_reply(Debug, S, Caller, Reply) -> - reply(Caller, Reply), - sys_debug(Debug, S, {out,Reply,Caller}). +do_reply(Debug, S, From, Reply) -> + reply(From, Reply), + sys_debug(Debug, S, {out,Reply,From}). terminate( -- cgit v1.2.3 From 6bf2768c6836440634019d69231534ed69fcf982 Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Fri, 18 Mar 2016 10:23:48 +0100 Subject: Do more intricate Fred Hebert doc changes --- lib/stdlib/src/gen_statem.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 82ac5824eb..9c1e126507 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -86,7 +86,7 @@ %% If 'true' hibernate the server instead of going into receive boolean(). -type event_timeout() :: - %% Generate a ('timeout', Msg, ...) event after Time + %% Generate a ('timeout', EventContent, ...) event after Time %% unless some other event is delivered Time :: timeout(). @@ -113,7 +113,7 @@ %% (Timeout :: event_timeout()) | % {timeout,Timeout} {'timeout', % Set the event timeout option - Time :: event_timeout(), Msg :: term()} | + Time :: event_timeout(), EventContent :: term()} | %% reply_action() | %% @@ -1054,17 +1054,17 @@ loop_event_actions( undefined -> %% No state timeout has been requested {Q3,undefined}; - {timeout,Time,Msg} -> + {timeout,Time,EventContent} -> %% A state timeout has been requested case Q3 of [] when Time =:= 0 -> %% Immediate timeout - simulate it %% so we do not get the timeout message %% after any received event - {[{timeout,Msg}],undefined}; + {[{timeout,EventContent}],undefined}; [] -> %% Actually start a timer - {Q3,erlang:start_timer(Time, self(), Msg)}; + {Q3,erlang:start_timer(Time, self(), EventContent)}; _ -> %% Do not start a timer since any queued %% event cancels the state timer so we pretend -- cgit v1.2.3 From 9db6054d674969fef314bf8676b6f9b583af3bef Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Tue, 12 Apr 2016 14:30:02 +0200 Subject: Fix missing short forms for event timeout --- lib/stdlib/src/gen_statem.erl | 75 +++++++++++++++++++++++++------------------ 1 file changed, 43 insertions(+), 32 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 9c1e126507..b3a149a569 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -942,12 +942,32 @@ loop_event_actions( State, NextState, NewData, [Action|Actions], Postpone, Hibernate, Timeout, NextEvents) -> case Action of + %% Actual actions + {reply,From,Reply} -> + case from(From) of + true -> + NewDebug = do_reply(Debug, S, From, Reply), + loop_event_actions( + Parent, NewDebug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents); + false -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; + {next_event,Type,Content} -> + case event_type(Type) of + true -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, Timeout, + [{Type,Content}|NextEvents]); + false -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; %% Actions that set options - postpone -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, - true, Hibernate, Timeout, NextEvents); {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( Parent, Debug, S, Events, Event, @@ -956,11 +976,11 @@ loop_event_actions( {postpone,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); - hibernate -> + postpone -> loop_event_actions( Parent, Debug, S, Events, Event, State, NextState, NewData, Actions, - Postpone, true, Timeout, NextEvents); + true, Hibernate, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( Parent, Debug, S, Events, Event, @@ -969,6 +989,11 @@ loop_event_actions( {hibernate,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); + hibernate -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, true, Timeout, NextEvents); {timeout,infinity,_} -> % Clear timer - it will never trigger loop_event_actions( Parent, Debug, S, Events, Event, @@ -982,31 +1007,17 @@ loop_event_actions( {timeout,_,_} -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]); - %% Actual actions - {reply,From,Reply} -> - case from(From) of - true -> - NewDebug = do_reply(Debug, S, From, Reply), - loop_event_actions( - Parent, NewDebug, S, Events, Event, - State, NextState, NewData, Actions, - Postpone, Hibernate, Timeout, NextEvents); - false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) - end; - {next_event,Type,Content} -> - case event_type(Type) of - true -> - loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, - Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents]); - false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) - end; + infinity -> % Clear timer - it will never trigger + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, undefined, NextEvents); + Time when is_integer(Time), Time >= 0 -> + NewTimeout = {timeout,Time,Time}, + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, NewTimeout, NextEvents); _ -> ?TERMINATE( error, {bad_action,Action}, Debug, S, [Event|Events]) -- cgit v1.2.3 From 26b3c7d60d52d8a7be006b06d856bb0f7276e77a Mon Sep 17 00:00:00 2001 From: Raimo Niskanen Date: Thu, 21 Apr 2016 15:58:52 +0200 Subject: Modify code_change/4 to return CallbackMode Also move check of non-atom states in callback mode state_functions to where the state function is called. This gives homogenous diagnostics for state functions, code_change/4 and system_replace_state StateFun. Irregularities pointed out by James Fish. --- lib/stdlib/src/gen_statem.erl | 60 ++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 29 deletions(-) (limited to 'lib/stdlib/src') diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index b3a149a569..c85c521d8e 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -219,7 +219,9 @@ OldState :: state(), OldData :: data(), Extra :: term()) -> - {ok, NewState :: state(), NewData :: data()}. + {NewCallbackMode :: callback_mode(), + NewState :: state(), + NewData :: data()}. %% Format the callback module state in some sensible that is %% often condensed way. For StatusOption =:= 'normal' the perferred @@ -491,17 +493,10 @@ enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> Actions :: [action()] | action()) -> no_return(). enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> - case is_atom(Module) andalso callback_mode(CallbackMode) of - true -> - Parent = gen:get_parent(), - enter( - Module, Opts, CallbackMode, State, Data, Server, - Actions, Parent); - false -> - error( - badarg, - [Module,Opts,CallbackMode,State,Data,Server,Actions]) - end. + is_atom(Module) orelse error({atom,Module}), + callback_mode(CallbackMode) orelse error({callback_mode,CallbackMode}), + Parent = gen:get_parent(), + enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -580,15 +575,13 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of {CallbackMode,State,Data} -> case callback_mode(CallbackMode) of - true - when CallbackMode =:= state_functions, is_atom(State); - CallbackMode =/= state_functions -> + true -> proc_lib:init_ack(Starter, {ok,self()}), enter( Module, Opts, CallbackMode, State, Data, ServerRef, [], Parent); false -> - Error = {bad_return_value,Result}, + Error = {callback_mode,CallbackMode}, proc_lib:init_ack(Starter, {error,Error}), exit(Error) end; @@ -600,7 +593,7 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> Module, Opts, CallbackMode, State, Data, ServerRef, Actions, Parent); false -> - Error = {bad_return_value,Result}, + Error = {callback_mode,CallbackMode}, proc_lib:init_ack(Starter, {error,Error}), exit(Error) end; @@ -638,11 +631,12 @@ system_code_change( Result -> Result end of - {ok,NewState,NewData} -> - {ok, - S#{ - state := NewState, - data := NewData}}; + {NewCallbackMode,NewState,NewData} -> + callback_mode(NewCallbackMode) orelse + error({callback_mode,NewCallbackMode}), + {ok,S#{state := NewState, data := NewData}}; + {ok,_} = Error -> + error({case_clause,Error}); Error -> Error end. @@ -825,6 +819,18 @@ loop_events( Result -> loop_event_result( Parent, Debug, S, Events, Event, Result); + error:badarg when CallbackMode =:= state_functions -> + case erlang:get_stacktrace() of + [{erlang,apply,[Module,State,_],_}|Stacktrace] -> + Args = [Type,Content,Data], + terminate( + error, + {undef_state_function,{Module,State,Args}}, + Stacktrace, + Debug, S, Q); + Stacktrace -> + terminate(error, badarg, Stacktrace, Debug, S, Q) + end; error:undef -> %% Process an undef to check for the simple mistake %% of calling a nonexistent state function @@ -861,7 +867,7 @@ loop_events( %% Interpret all callback return variants loop_event_result( Parent, Debug, - #{callback_mode := CallbackMode, state := State, data := Data} = S, + #{state := State, data := Data} = S, Events, Event, Result) -> case Result of stop -> @@ -887,15 +893,11 @@ loop_event_result( exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), %% Since we got back here Replies was bad terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); - {next_state,NextState,NewData} - when CallbackMode =:= state_functions, is_atom(NextState); - CallbackMode =/= state_functions -> + {next_state,NextState,NewData} -> loop_event_actions( Parent, Debug, S, Events, Event, State, NextState, NewData, []); - {next_state,NextState,NewData,Actions} - when CallbackMode =:= state_functions, is_atom(NextState); - CallbackMode =/= state_functions -> + {next_state,NextState,NewData,Actions} -> loop_event_actions( Parent, Debug, S, Events, Event, State, NextState, NewData, Actions); -- cgit v1.2.3