aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2016-04-25 17:04:35 +0200
committerRaimo Niskanen <[email protected]>2016-04-25 17:04:35 +0200
commitb6da7406d35f9decaaa7fa089f58ed03879dadfe (patch)
treea4f767bad05d024615b104053839e72023c72f23 /lib/stdlib/src
parentb842026cc5e86cf7f054da073f6da16adf02baa9 (diff)
parentf06f69068807168cf4cc731711ed82489cc5b99c (diff)
downloadotp-b6da7406d35f9decaaa7fa089f58ed03879dadfe.tar.gz
otp-b6da7406d35f9decaaa7fa089f58ed03879dadfe.tar.bz2
otp-b6da7406d35f9decaaa7fa089f58ed03879dadfe.zip
Merge branch 'raimo/new-gen-state-machine/OTP-13065'
* raimo/new-gen-state-machine/OTP-13065: (52 commits) Add section on state filtering Promote gen_statem over gen_fsm Modify code_change/4 to return CallbackMode Use ?NAME macro in examples Introduce Fred Herbert suggested additions Introduce corrections from Fred Hebert and Ingela Use .png pictures instead of .gif Write Design Principles chapter Fix missing short forms for event timeout Do more intricate Fred Hebert doc changes Change Caller -> From as suggested by Fred Hebert Do documentation improvements from Fred Hebert Fix broken documenation reference Rename state_timeout -> event_timeout Fix most of the system docs and emacs mode Change code_change/4 to {ok,State,Data} Fixup sharpened test suite Sharpen test suite Remove the remove_event action and all alike Relax caller() type check and cleanup ... Conflicts: lib/stdlib/src/gen.erl lib/stdlib/src/gen_event.erl lib/stdlib/src/gen_fsm.erl lib/stdlib/src/gen_server.erl lib/stdlib/test/error_logger_forwarder.erl
Diffstat (limited to 'lib/stdlib/src')
-rw-r--r--lib/stdlib/src/Makefile3
-rw-r--r--lib/stdlib/src/gen.erl119
-rw-r--r--lib/stdlib/src/gen_event.erl9
-rw-r--r--lib/stdlib/src/gen_fsm.erl83
-rw-r--r--lib/stdlib/src/gen_server.erl110
-rw-r--r--lib/stdlib/src/gen_statem.erl1257
-rw-r--r--lib/stdlib/src/proc_lib.erl14
-rw-r--r--lib/stdlib/src/stdlib.app.src1
8 files changed, 1383 insertions, 213 deletions
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.erl b/lib/stdlib/src/gen.erl
index 9811a211ae..597830cf9a 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -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 1303036168..ccacf658e9 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -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 2b4b76105e..6e7528fd98 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -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 fa6fff6dca..5800aca66f 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -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
%%-----------------------------------------------------------------
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
new file mode 100644
index 0000000000..c85c521d8e
--- /dev/null
+++ b/lib/stdlib/src/gen_statem.erl
@@ -0,0 +1,1257 @@
+%%
+%% %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/5,enter_loop/6,enter_loop/7,
+ reply/1,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]).
+
+%% 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]).
+
+%%%==========================================================================
+%%% Interface functions.
+%%%==========================================================================
+
+-type from() ::
+ {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',From :: from()} | 'cast' |
+ 'info' | 'timeout' | 'internal'.
+
+-type callback_mode() :: 'state_functions' | 'handle_event_function'.
+
+-type transition_option() ::
+ postpone() | hibernate() | event_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 event_timeout() ::
+ %% Generate a ('timeout', EventContent, ...) event after Time
+ %% unless some other event is delivered
+ Time :: timeout().
+
+-type action() ::
+ %% During a state change:
+ %% * NextState 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 :: event_timeout()) | % {timeout,Timeout}
+ {'timeout', % Set the event timeout option
+ Time :: event_timeout(), EventContent :: 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()}.
+-type reply_action() ::
+ {'reply', % Reply to a caller
+ From :: from(), Reply :: term()}.
+
+-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()} |
+ {'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()} |
+ {'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
+%% 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()) ->
+ {callback_mode(), state(), data()} |
+ {callback_mode(), state(), data(), [action()] | action()} |
+ 'ignore' |
+ {'stop', Reason :: term()}.
+
+%% 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().
+%%
+%% Note that state callbacks and only state callbacks have arity 5
+%% and that is intended.
+-callback state_name(
+ event_type(),
+ EventContent :: term(),
+ Data :: data()) ->
+ state_function_result().
+%%
+%% State callback for callback_mode() =:= handle_event_function.
+%%
+%% Note that state callbacks and only state callbacks have arity 5
+%% and that is intended.
+-callback handle_event(
+ event_type(),
+ EventContent :: term(),
+ State :: state(), % Current state
+ Data :: data()) ->
+ handle_event_result().
+
+%% Clean up before the server terminates.
+-callback terminate(
+ Reason :: 'normal' | 'shutdown' | {'shutdown', term()}
+ | term(),
+ State :: state(),
+ Data :: 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(),
+ OldData :: data(),
+ Extra :: term()) ->
+ {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
+%% return term is [{data,[{"State",FormattedState}]}], and for
+%% StatusOption =:= 'terminate' it is just FormattedState.
+-callback format_status(
+ StatusOption,
+ [ [{Key :: term(), Value :: term()}] |
+ state() |
+ data()]) ->
+ Status :: term() when
+ StatusOption :: 'normal' | 'terminate'.
+
+-optional_callbacks(
+ [init/1, % One may use enter_loop/5,6,7 instead
+ format_status/2, % Has got a default implementation
+ %%
+ state_name/3, % Example for callback_mode =:= state_functions:
+ %% there has to be a StateName/5 callback function for every StateName.
+ %%
+ handle_event/4]). % For callback_mode =:= handle_event_function
+
+%% Type validation functions
+callback_mode(CallbackMode) ->
+ case CallbackMode of
+ state_functions ->
+ true;
+ handle_event_function ->
+ true;
+ _ ->
+ false
+ end.
+%%
+from({Pid,_}) when is_pid(Pid) ->
+ true;
+from(_) ->
+ false.
+%%
+event_type({call,From}) ->
+ from(From);
+event_type(Type) ->
+ case Type of
+ cast ->
+ true;
+ info ->
+ true;
+ timeout ->
+ true;
+ internal ->
+ true;
+ _ ->
+ false
+ end.
+
+
+
+-define(
+ STACKTRACE(),
+ try throw(ok) catch _ -> erlang:get_stacktrace() end).
+
+-define(
+ TERMINATE(Class, Reason, Debug, S, Q),
+ terminate(
+ begin Class end,
+ begin Reason end,
+ ?STACKTRACE(),
+ begin Debug end,
+ begin S end,
+ begin Q 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', [proc_lib:spawn_option()]}.
+-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}.
+
+
+
+%% Start a state machine
+-spec start(
+ Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
+ start_ret().
+start(Module, Args, Opts) ->
+ gen:start(?MODULE, nolink, Module, Args, Opts).
+%%
+-spec start(
+ ServerName :: server_name(),
+ Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
+ start_ret().
+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(), Opts :: [start_opt()]) ->
+ start_ret().
+start_link(Module, Args, Opts) ->
+ gen:start(?MODULE, link, Module, Args, Opts).
+%%
+-spec start_link(
+ ServerName :: server_name(),
+ Module :: module(), Args :: term(), Opts :: [start_opt()]) ->
+ start_ret().
+start_link(ServerName, Module, Args, Opts) ->
+ gen:start(?MODULE, link, ServerName, Module, Args, Opts).
+
+%% 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, wrap_cast(Msg)) of
+ _ -> ok
+ catch
+ _:_ -> ok
+ end;
+cast({via,RegMod,Name}, Msg) ->
+ try RegMod:send(Name, wrap_cast(Msg)) of
+ _ -> ok
+ catch
+ _:_ -> ok
+ end;
+cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) ->
+ send(ServerRef, wrap_cast(Msg));
+cast(ServerRef, Msg) when is_atom(ServerRef) ->
+ send(ServerRef, wrap_cast(Msg));
+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,From}
+-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 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([reply_action()] | reply_action()) -> ok.
+reply({reply,From,Reply}) ->
+ reply(From, Reply);
+reply(Replies) when is_list(Replies) ->
+ replies(Replies).
+%%
+-spec reply(From :: from(), Reply :: term()) -> ok.
+reply({To,Tag}, Reply) when is_pid(To) ->
+ 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(), Opts :: [debug_opt()],
+ CallbackMode :: callback_mode(),
+ State :: state(), Data :: data()) ->
+ no_return().
+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_Actions ::
+ server_name() | pid() | [action()]) ->
+ no_return().
+enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) ->
+ if
+ is_list(Server_or_Actions) ->
+ enter_loop(
+ Module, Opts, CallbackMode, State, Data,
+ self(), Server_or_Actions);
+ true ->
+ enter_loop(
+ Module, Opts, CallbackMode, State, Data,
+ Server_or_Actions, [])
+ end.
+%%
+-spec enter_loop(
+ Module :: module(), Opts :: [debug_opt()],
+ CallbackMode :: callback_mode(),
+ State :: state(), Data :: data(),
+ Server :: server_name() | pid(),
+ Actions :: [action()] | action()) ->
+ no_return().
+enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) ->
+ 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
+
+wrap_cast(Event) ->
+ {'$gen_cast',Event}.
+
+replies([{reply,From,Reply}|Replies]) ->
+ reply(From, Reply),
+ replies(Replies);
+replies([]) ->
+ ok.
+
+%% Might actually not send the message in case of caught exception
+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/6 and enter_loop/5,6,7 functions converge
+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),
+ PrevState = 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 => PrevState,
+ data => Data,
+ timer => undefined,
+ postponed => [],
+ hibernate => false},
+ loop_event_actions(
+ Parent, Debug, S, [],
+ {event,undefined}, % Will be discarded thanks to {postpone,false}
+ PrevState, State, Data, NewActions).
+
+%%%==========================================================================
+%%% 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 ->
+ init_result(Starter, Parent, ServerRef, Module, Result, Opts)
+ catch
+ Result ->
+ init_result(Starter, Parent, ServerRef, Module, Result, Opts);
+ 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, Opts) ->
+ case Result of
+ {CallbackMode,State,Data} ->
+ case callback_mode(CallbackMode) of
+ true ->
+ proc_lib:init_ack(Starter, {ok,self()}),
+ enter(
+ Module, Opts, CallbackMode, State, Data,
+ ServerRef, [], Parent);
+ false ->
+ Error = {callback_mode,CallbackMode},
+ proc_lib:init_ack(Starter, {error,Error}),
+ exit(Error)
+ end;
+ {CallbackMode,State,Data,Actions} ->
+ case callback_mode(CallbackMode) of
+ true ->
+ proc_lib:init_ack(Starter, {ok,self()}),
+ enter(
+ Module, Opts, CallbackMode, State, Data,
+ ServerRef, Actions, Parent);
+ false ->
+ Error = {callback_mode,CallbackMode},
+ proc_lib:init_ack(Starter, {error,Error}),
+ exit(Error)
+ end;
+ {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);
+ _ ->
+ Error = {bad_return_value,Result},
+ 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(exit, Reason, Debug, S, []).
+
+system_code_change(
+ #{module := Module,
+ state := State,
+ data := Data} = S,
+ _Mod, OldVsn, Extra) ->
+ case
+ try Module:code_change(OldVsn, State, Data, Extra)
+ catch
+ Result -> Result
+ end
+ of
+ {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.
+
+system_get_state(#{state := State, data := Data}) ->
+ {ok,{State,Data}}.
+
+system_replace_state(
+ StateFun,
+ #{state := State,
+ data := Data} = S) ->
+ {NewState,NewData} = Result = StateFun({State,Data}),
+ {ok,Result,S#{state := NewState, data := NewData}}.
+
+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 ->
+ %% 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.
+
+%% Entry point for wakeup_from_hibernate/3
+loop_receive(Parent, Debug, #{timer := Timer} = S) ->
+ receive
+ 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, Hibernate);
+ {'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(exit, Reason, Debug, S, [EXIT]);
+ {timeout,Timer,Content} when Timer =/= undefined ->
+ loop_event(
+ 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',From,Request} ->
+ {{call,From},Request};
+ {'$gen_cast',E} ->
+ {cast,E};
+ _ ->
+ {info,Msg}
+ end,
+ loop_event(Parent, Debug, S, Event)
+ end
+ end.
+
+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]).
+
+%% 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,
+ #{callback_mode := CallbackMode,
+ module := Module,
+ state := State,
+ data := Data} = S,
+ [{Type,Content} = Event|Events] = Q) ->
+ try
+ case CallbackMode of
+ state_functions ->
+ Module:State(Type, Content, Data);
+ handle_event_function ->
+ Module:handle_event(Type, Content, State, Data)
+ end of
+ Result ->
+ loop_event_result(
+ Parent, Debug, S, Events, Event, Result)
+ catch
+ 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
+ case erlang:get_stacktrace() of
+ [{Module,State,
+ [Type,Content,Data]=Args,
+ _}
+ |Stacktrace]
+ when CallbackMode =:= state_functions ->
+ terminate(
+ error,
+ {undef_state_function,{Module,State,Args}},
+ Stacktrace,
+ Debug, S, Q);
+ [{Module,handle_event,
+ [Type,Content,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;
+ Class:Reason ->
+ Stacktrace = erlang:get_stacktrace(),
+ terminate(Class, Reason, Stacktrace, Debug, S, Q)
+ end.
+
+%% Interpret all callback return variants
+loop_event_result(
+ Parent, Debug,
+ #{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} ->
+ NewS = S#{data := NewData},
+ Q = [Event|Events],
+ ?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(Class, NewReason, Stacktrace, NewDebug, NewS, Q);
+ {next_state,NextState,NewData} ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, NextState, NewData, []);
+ {next_state,NextState,NewData,Actions} ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, NextState, NewData, Actions);
+ {keep_state,NewData} ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, State, NewData, []);
+ {keep_state,NewData,Actions} ->
+ 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,
+ State, State, Data, Actions);
+ _ ->
+ ?TERMINATE(
+ error, {bad_return_value,Result}, Debug, S, [Event|Events])
+ end.
+
+loop_event_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, NextState, NewData,
+ if
+ is_list(Actions) ->
+ Actions;
+ true ->
+ [Actions]
+ end,
+ Postpone, Hibernate, Timeout, NextEvents).
+%%
+%% Process all action()s
+loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ 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,NewPostpone} when is_boolean(NewPostpone) ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, NextState, NewData, Actions,
+ NewPostpone, Hibernate, Timeout, NextEvents);
+ {postpone,_} ->
+ ?TERMINATE(
+ error, {bad_action,Action}, Debug, S, [Event|Events]);
+ postpone ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, NextState, NewData, Actions,
+ true, Hibernate, Timeout, NextEvents);
+ {hibernate,NewHibernate} when is_boolean(NewHibernate) ->
+ loop_event_actions(
+ Parent, Debug, S, Events, Event,
+ State, NextState, NewData, Actions,
+ Postpone, NewHibernate, Timeout, NextEvents);
+ {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,
+ 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, NextState, NewData, Actions,
+ Postpone, Hibernate, NewTimeout, NextEvents);
+ {timeout,_,_} ->
+ ?TERMINATE(
+ error, {bad_action,Action}, Debug, S, [Event|Events]);
+ 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])
+ end;
+%%
+%% End of actions list
+loop_event_actions(
+ Parent, Debug, #{postponed := P0} = S, Events, Event,
+ State, NextState, 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 ->
+ [Event|P0];
+ false ->
+ P0
+ end,
+ {Q2,P} = % Move all postponed events to queue if state change
+ if
+ NextState =:= State ->
+ {Events,P1};
+ true ->
+ {lists:reverse(P1, Events),[]}
+ end,
+ %% Place next events first in queue
+ Q3 = lists:reverse(NextEvents, Q2),
+ %%
+ NewDebug =
+ sys_debug(
+ Debug, S,
+ case Postpone of
+ true ->
+ {postpone,Event,NextState};
+ false ->
+ {consume,Event,NextState}
+ end),
+ %% 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,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,EventContent}],undefined};
+ [] ->
+ %% Actually start a timer
+ {Q3,erlang:start_timer(Time, self(), EventContent)};
+ _ ->
+ %% 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 := NextState,
+ data := NewData,
+ timer := Timer,
+ postponed := P,
+ hibernate := Hibernate},
+ Q).
+
+%%---------------------------------------------------------------------------
+%% Server helpers
+
+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);
+do_reply_then_terminate(
+ Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) ->
+ case R of
+ {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, From, Reply) ->
+ reply(From, Reply),
+ sys_debug(Debug, S, {out,Reply,From}).
+
+
+terminate(
+ Class, Reason, Stacktrace, Debug,
+ #{module := Module,
+ state := State, data := Data} = S,
+ Q) ->
+ try Module:terminate(Reason, State, Data) of
+ _ -> ok
+ catch
+ _ -> ok;
+ C:R ->
+ ST = erlang:get_stacktrace(),
+ error_info(
+ C, R, ST, Debug, S, 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, S, 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 := Name, callback_mode := CallbackMode,
+ state := State, postponed := P},
+ Q, FmtData) ->
+ {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 =
+ if
+ is_list(Args) ->
+ length(Args);
+ is_integer(Args) ->
+ Args
+ end,
+ 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" ++
+ "** State = ~p~n" ++
+ "** Callback mode = ~p~n" ++
+ "** Queued/Postponed = ~w/~w~n" ++
+ case FixedStacktrace of
+ [] ->
+ "";
+ _ ->
+ "** Stacktrace =~n"
+ "** ~p~n"
+ end,
+ [Name |
+ case Q of
+ [] ->
+ [];
+ [Event|_] ->
+ [Event]
+ end] ++
+ [FmtData,Class,FixedReason,
+ State,CallbackMode,length(Q),length(P)] ++
+ 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, data := Data}) ->
+ case erlang:function_exported(Module, format_status, 2) of
+ true ->
+ try Module:format_status(Opt, [PDict,State,Data])
+ catch
+ Result -> Result;
+ _:_ ->
+ format_status_default(
+ Opt, State,
+ "Module:format_status/2 crashed")
+ end;
+ false ->
+ format_status_default(Opt, State, Data)
+ end.
+
+%% The default Module:format_status/2
+format_status_default(Opt, State, Data) ->
+ SSD = {State,Data},
+ case Opt of
+ terminate ->
+ SSD;
+ _ ->
+ [{data,[{"State",SSD}]}]
+ end.
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index c47d30c8b8..3f79ed0f87 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -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 e3950ee795..32bcdc4f2a 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -65,6 +65,7 @@
gen_event,
gen_fsm,
gen_server,
+ gen_statem,
io,
io_lib,
io_lib_format,