aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl28
-rw-r--r--lib/hipe/icode/hipe_icode_primops.erl8
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary.erl2
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl37
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl48
-rw-r--r--lib/kernel/doc/src/gen_tcp.xml6
-rw-r--r--lib/kernel/doc/src/gen_udp.xml6
-rw-r--r--lib/kernel/src/gen_sctp.erl2
-rw-r--r--lib/kernel/src/gen_tcp.erl2
-rw-r--r--lib/kernel/src/gen_udp.erl2
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml79
-rw-r--r--lib/stdlib/doc/src/maps.xml2
-rw-r--r--lib/stdlib/src/gen_statem.erl668
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl30
-rw-r--r--lib/tools/emacs/Makefile1
-rw-r--r--lib/tools/emacs/erlang-start.el14
-rw-r--r--lib/tools/emacs/erlang.el5
-rw-r--r--lib/tools/emacs/erldoc.el508
-rw-r--r--system/doc/design_principles/statem.xml29
19 files changed, 1058 insertions, 419 deletions
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 224aacd8d7..3386523206 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -763,32 +763,10 @@ trans_fun([{test,bs_test_unit,{f,Lbl},[Ms,Unit]}|
[MsVar], [], Env, Instructions);
trans_fun([{test,bs_match_string,{f,Lbl},[Ms,BitSize,Bin]}|
Instructions], Env) ->
- True = mk_label(new),
- FalseLabName = map_label(Lbl),
- TrueLabName = hipe_icode:label_name(True),
+ %% the current match buffer
MsVar = mk_var(Ms),
- TmpVar = mk_var(new),
- ByteSize = BitSize div 8,
- ExtraBits = BitSize rem 8,
- WordSize = hipe_rtl_arch:word_size(),
- if ExtraBits =:= 0 ->
- trans_op_call({hipe_bs_primop,{bs_match_string,Bin,ByteSize}}, Lbl,
- [MsVar], [MsVar], Env, Instructions);
- BitSize =< ((WordSize * 8) - 5) ->
- <<Int:BitSize, _/bits>> = Bin,
- {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,BitSize,0}}, Lbl,
- [MsVar], [TmpVar, MsVar], Env),
- I2 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName),
- I1 ++ [I2,True] ++ trans_fun(Instructions, Env1);
- true ->
- <<RealBin:ByteSize/binary, Int:ExtraBits, _/bits>> = Bin,
- {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_match_string,RealBin,ByteSize}}, Lbl,
- [MsVar], [MsVar], Env),
- {I2,Env2} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,ExtraBits,0}}, Lbl,
- [MsVar], [TmpVar, MsVar], Env1),
- I3 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName),
- I1 ++ I2 ++ [I3,True] ++ trans_fun(Instructions, Env2)
- end;
+ Primop = {hipe_bs_primop, {bs_match_string, Bin, BitSize}},
+ trans_op_call(Primop, Lbl, [MsVar], [MsVar], Env, Instructions);
trans_fun([{bs_context_to_binary,Var}|Instructions], Env) ->
%% the current match buffer
IVars = [trans_arg(Var)],
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index cee37b6a57..2a141c514e 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -287,8 +287,8 @@ pp(Dev, Op) ->
io:format(Dev, "bs_start_match<~w>", [Max]);
{{bs_start_match, Type}, Max} ->
io:format(Dev, "bs_start_match<~w,~w>", [Type,Max]);
- {bs_match_string, String, SizeInBytes} ->
- io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBytes]);
+ {bs_match_string, String, SizeInBits} ->
+ io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBits]);
{bs_get_integer, Size, Flags} ->
io:format(Dev, "bs_get_integer<~w, ~w>", [Size, Flags]);
{bs_get_float, Size, Flags} ->
@@ -596,10 +596,10 @@ type(Primop, Args) ->
erl_types:t_subtract(Type, erl_types:t_matchstate()),
erl_types:t_matchstate_slot(
erl_types:t_inf(Type, erl_types:t_matchstate()), 0));
- {hipe_bs_primop, {bs_match_string,_,Bytes}} ->
+ {hipe_bs_primop, {bs_match_string,_,Bits}} ->
[MatchState] = Args,
BinType = erl_types:t_matchstate_present(MatchState),
- NewBinType = match_bin(erl_types:t_bitstr(0, Bytes*8), BinType),
+ NewBinType = match_bin(erl_types:t_bitstr(0, Bits), BinType),
erl_types:t_matchstate_update_present(NewBinType, MatchState);
{hipe_bs_primop, {bs_test_unit,Unit}} ->
[MatchState] = Args,
diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl
index fb9c0c196d..9b400f4c93 100644
--- a/lib/hipe/rtl/hipe_rtl_binary.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary.erl
@@ -19,7 +19,7 @@
%%% %CopyrightEnd%
%%%
%%%-------------------------------------------------------------------
-%%% File : hipe_rtl_binary_2.erl
+%%% File : hipe_rtl_binary.erl
%%% Author : Per Gustafsson <[email protected]>
%%% Description :
%%%
diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
index 528672b893..d999cd2743 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_match.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -270,24 +270,23 @@ gen_rtl({bs_save, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) ->
set_field_from_term({matchstate, {saveoffset, Slot}}, Ms, Offset),
hipe_rtl:mk_goto(TrueLblName)];
%% ----- bs_match_string -----
-gen_rtl({bs_match_string, String, ByteSize}, Dst, [Ms],
+gen_rtl({bs_match_string, String, BitSize}, Dst, [Ms],
TrueLblName, FalseLblName) ->
{[Offset, BinSize, Base], Instrs} =
extract_matchstate_vars([offset, binsize, base], Ms),
[SuccessLbl, ALbl, ULbl] = create_lbls(3),
[NewOffset, BitOffset] = create_gcsafe_regs(2),
- Unit = hipe_rtl_arch:word_size() - 1,
- Loops = ByteSize div Unit,
- Init =
+ Unit = (hipe_rtl_arch:word_size() - 1) * ?BYTE_SIZE,
+ Init =
[Instrs,
opt_update_ms(Dst, Ms),
- check_size(Offset, hipe_rtl:mk_imm(ByteSize*?BYTE_SIZE), BinSize,
+ check_size(Offset, hipe_rtl:mk_imm(BitSize), BinSize,
NewOffset, hipe_rtl:label_name(SuccessLbl), FalseLblName),
SuccessLbl],
SplitCode =
[hipe_rtl:mk_alub(BitOffset, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS), eq,
hipe_rtl:label_name(ALbl), hipe_rtl:label_name(ULbl))],
- Loops = ByteSize div Unit,
+ Loops = BitSize div Unit,
SkipSize = Loops * Unit,
{ACode1, UCode1} =
case Loops of
@@ -297,9 +296,9 @@ gen_rtl({bs_match_string, String, ByteSize}, Dst, [Ms],
create_loops(Loops, Unit, String, Base,
Offset, BitOffset, FalseLblName)
end,
- <<_:SkipSize/binary, RestString/binary>> = String,
+ <<_:SkipSize/bits, RestString/bits>> = String,
{ACode2, UCode2} =
- case ByteSize rem Unit of
+ case BitSize rem Unit of
0 ->
{[], []};
Rem ->
@@ -393,12 +392,12 @@ validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) ->
create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) ->
[Reg] = create_gcsafe_regs(1),
AlignedFun = fun(Value) ->
- [get_int_to_reg(Reg, Unit*?BYTE_SIZE, Base, Offset, 'srl',
+ [get_int_to_reg(Reg, Unit, Base, Offset, 'srl',
{unsigned, big}),
update_and_test(Reg, Unit, Offset, Value, FalseLblName)]
end,
UnAlignedFun = fun(Value) ->
- [get_unaligned_int_to_reg(Reg, Unit*?BYTE_SIZE,
+ [get_unaligned_int_to_reg(Reg, Unit,
Base, Offset, BitOffset,
'srl', {unsigned, big})|
update_and_test(Reg, Unit, Offset, Value, FalseLblName)]
@@ -406,31 +405,31 @@ create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) ->
{create_loops(Loops, Unit, String, AlignedFun),
create_loops(Loops, Unit, String, UnAlignedFun)}.
-create_rests(Rem, String, Base, Offset, BitOffset, FalseLblName) ->
+create_rests(RemBits, String, Base, Offset, BitOffset, FalseLblName) ->
[Reg] = create_gcsafe_regs(1),
AlignedFun = fun(Value) ->
- [get_int_to_reg(Reg, Rem*?BYTE_SIZE, Base, Offset, 'srl',
+ [get_int_to_reg(Reg, RemBits, Base, Offset, 'srl',
{unsigned, big})|
just_test(Reg, Value, FalseLblName)]
end,
UnAlignedFun = fun(Value) ->
- [get_unaligned_int_to_reg(Reg, Rem*?BYTE_SIZE,
+ [get_unaligned_int_to_reg(Reg, RemBits,
Base, Offset, BitOffset,
'srl', {unsigned, big})|
just_test(Reg, Value, FalseLblName)]
end,
- {create_loops(1, Rem, String, AlignedFun),
- create_loops(1, Rem, String, UnAlignedFun)}.
+ {create_loops(1, RemBits, String, AlignedFun),
+ create_loops(1, RemBits, String, UnAlignedFun)}.
create_loops(0, _Unit, _String, _IntFun) ->
[];
create_loops(N, Unit, String, IntFun) ->
- {Value, RestString} = get_value(Unit,String),
+ {Value, RestString} = get_value(Unit, String),
[IntFun(Value),
create_loops(N-1, Unit, RestString, IntFun)].
update_and_test(Reg, Unit, Offset, Value, FalseLblName) ->
- [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(Unit*?BYTE_SIZE), FalseLblName),
+ [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(Unit), FalseLblName),
just_test(Reg, Value, FalseLblName)].
just_test(Reg, Value, FalseLblName) ->
@@ -439,8 +438,8 @@ just_test(Reg, Value, FalseLblName) ->
hipe_rtl:label_name(ContLbl), FalseLblName),
ContLbl].
-get_value(N,String) ->
- <<I:N/integer-unit:8, Rest/binary>> = String,
+get_value(N, String) ->
+ <<I:N, Rest/bits>> = String,
{I, Rest}.
make_int_gc_code(I) when is_integer(I) ->
diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl
index b280705a47..d9f3278b45 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl
@@ -9,6 +9,7 @@ test() ->
<<49,50,51>> = lex_digits1(Bin, 1, []),
<<49,50,51>> = lex_digits2(Bin, 1, []),
ok = var_bind_bug(<<1, 2, 3, 4, 5, 6, 7, 8>>),
+ ok = bs_match_string_bug(),
ok.
%%--------------------------------------------------------------------
@@ -65,3 +66,50 @@ var_bind_bug(<<A:1/binary, B:8/integer, _C:B/binary, _Rest/binary>>) ->
B -> wrong;
_ -> ok
end.
+
+%%--------------------------------------------------------------------
+%% From: Andreas Schultz
+%% Date: 2/11/2016
+%%
+%% Either HiPE is messing up binary matches in some cases or I'm not
+%% seeing the problem. ... <SNIP PROGRAM - CLEANED UP VERSION BELOW>
+%% With Erlang 19.1.3 the HiPE compiled version behaves differently
+%% than the non-HiPE version: ... <SNIP TEST RUNS>
+%% So, do I do something wrong here or is this a legitimate HiPE bug?
+%%
+%% Yes, this was a legitimate HiPE bug: The BEAM to ICode tranaslation
+%% of the bs_match_string instruction, written long ago for binaries
+%% (i.e., with byte-sized strings), tried to do a `clever' translation
+%% of even bit-sized strings using a HiPE primop that took a `Size'
+%% argument expressed in *bytes*. ICode is not really the place to do
+%% such a thing, and moreover there is really no reason for the HiPE
+%% primop not to take a Size argument expressed in *bits* instead.
+%% The bug was fixed by changing the `Size' argument to be in bits,
+%% postponing the translation of the bs_match_string primop until RTL
+%% and doing a proper translation using bit-sized quantities there.
+%%--------------------------------------------------------------------
+
+bs_match_string_bug() ->
+ ok = test0(<<50>>),
+ Bin = data(),
+ ok = test1(Bin),
+ ok = test2(Bin),
+ ok.
+
+%% Minimal test case showing the problem matching with strings
+test0(<<6:5, 0:1, 0:2>>) -> weird;
+test0(<<6:5, _:1, _:2>>) -> ok;
+test0(_) -> default.
+
+data() -> <<50,16,0>>.
+
+%% This was the problematic test case in HiPE: 'default' was returned
+test1(<<1:3, 1:1, _:1, 0:1, 0:1, 0:1, _/binary>>) -> weird;
+test1(<<1:3, 1:1, _:1, _:1, _:1, _:1, _/binary>>) -> ok;
+test1(_) -> default.
+
+%% This variation of test1/1 above worked OK, even in HiPE
+test2(<<1:3, 1:1, _:1, A:1, B:1, C:1, _/binary>>)
+ when A =:= 1; B =:= 1; C =:= 1 -> ok;
+test2(<<1:3, 1:1, _:1, 0:1, 0:1, 0:1, _/binary>>) -> weird;
+test2(_) -> default.
diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml
index 08454b9832..e97db20062 100644
--- a/lib/kernel/doc/src/gen_tcp.xml
+++ b/lib/kernel/doc/src/gen_tcp.xml
@@ -231,7 +231,11 @@ do_recv(Sock, Bs) ->
<c><anno>Socket</anno></c>. The controlling process is the process
that receives messages from the socket. If called by any other
process than the current controlling process,
- <c>{error, not_owner}</c> is returned.</p>
+ <c>{error, not_owner}</c> is returned. If the process identified
+ by <c><anno>Pid</anno></c> is not an existing local pid,
+ <c>{error, badarg}</c> is returned. <c>{error, badarg}</c> may also
+ be returned in some cases when <c><anno>Socket</anno></c> is closed
+ during the execution of this function.</p>
<p>If the socket is set in active mode, this function
will transfer any messages in the mailbox of the caller
to the new controlling process.
diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml
index 3f88a0272d..f79566ef71 100644
--- a/lib/kernel/doc/src/gen_udp.xml
+++ b/lib/kernel/doc/src/gen_udp.xml
@@ -68,7 +68,11 @@
<c><anno>Socket</anno></c>. The controlling process is the process
that receives messages from the socket. If called by any other
process than the current controlling process,
- <c>{error, not_owner}</c> is returned.</p>
+ <c>{error, not_owner}</c> is returned. If the process identified
+ by <c><anno>Pid</anno></c> is not an existing local pid,
+ <c>{error, badarg}</c> is returned. <c>{error, badarg}</c> may also
+ be returned in some cases when <c><anno>Socket</anno></c> is closed
+ during the execution of this function.</p>
</desc>
</func>
diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl
index b133e6fed4..a6aa0edd15 100644
--- a/lib/kernel/src/gen_sctp.erl
+++ b/lib/kernel/src/gen_sctp.erl
@@ -439,7 +439,7 @@ error_string(X) ->
-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when
Socket :: sctp_socket(),
Pid :: pid(),
- Reason :: closed | not_owner | inet:posix().
+ Reason :: closed | not_owner | badarg | inet:posix().
controlling_process(S, Pid) when is_port(S), is_pid(Pid) ->
inet:udp_controlling_process(S, Pid);
diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl
index 1a21541b7c..ac61dbc792 100644
--- a/lib/kernel/src/gen_tcp.erl
+++ b/lib/kernel/src/gen_tcp.erl
@@ -320,7 +320,7 @@ unrecv(S, Data) when is_port(S) ->
-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when
Socket :: socket(),
Pid :: pid(),
- Reason :: closed | not_owner | inet:posix().
+ Reason :: closed | not_owner | badarg | inet:posix().
controlling_process(S, NewOwner) ->
case inet_db:lookup_socket(S) of
diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl
index 98d2f0bcfb..3121544719 100644
--- a/lib/kernel/src/gen_udp.erl
+++ b/lib/kernel/src/gen_udp.erl
@@ -195,7 +195,7 @@ connect(S, Address, Port) when is_port(S) ->
-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when
Socket :: socket(),
Pid :: pid(),
- Reason :: closed | not_owner | inet:posix().
+ Reason :: closed | not_owner | badarg | inet:posix().
controlling_process(S, NewOwner) ->
inet:udp_controlling_process(S, NewOwner).
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index 64267c2af5..fd498ee82e 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -533,7 +533,7 @@ handle_event(_, _, State, Data) ->
Type <c>info</c> originates from regular process messages sent
to the <c>gen_statem</c>. Also, the state machine
implementation can generate events of types
- <c>timeout</c>, <c>state_timeout</c>, <c>enter</c>,
+ <c>timeout</c>, <c>state_timeout</c>,
and <c>internal</c> to itself.
</p>
</desc>
@@ -639,6 +639,20 @@ handle_event(_, _, State, Data) ->
</p>
<list type="ordered">
<item>
+ <p>
+ If the state changes or is the initial state, and
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
+ are used, the <c>gen_statem</c> calls
+ the new state callback with arguments
+ <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
+ Any
+ <seealso marker="#type-enter_action"><c>actions</c></seealso>
+ returned from this call are handled as if they were
+ appended to the actions
+ returned by the state callback that changed states.
+ </p>
+ </item>
+ <item>
<p>
All
<seealso marker="#type-action">actions</seealso>
@@ -668,36 +682,36 @@ handle_event(_, _, State, Data) ->
</p>
</item>
<item>
- <p>
- If the state changes or is the initial state, and
- <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
- are used, the <c>gen_statem</c> calls
- the new state callback with arguments
- <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
- Any
- <seealso marker="#type-enter_action"><c>actions</c></seealso>
- returned from this call are handled as if they were
- appended to the actions
- returned by the state callback that changed states.
- </p>
- </item>
- <item>
- <p>
- If there are enqueued events the (possibly new)
- <seealso marker="#state callback">state callback</seealso>
- is called with the oldest enqueued event,
- and we start again from the top of this list.
- </p>
- </item>
- <item>
<p>
Timeout timers
<seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso>
and
<seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso>
- are handled. This may lead to a time-out zero event
- being generated to the
+ are handled. Time-outs with zero time are guaranteed to be
+ delivered to the state machine before any external
+ not yet received event so if there is such a timeout requested,
+ the corresponding time-out zero event is enqueued as
+ the newest event.
+ </p>
+ <p>
+ Any event cancels an
+ <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso>
+ so a zero time event time-out is only generated
+ if the event queue is empty.
+ </p>
+ <p>
+ A state change cancels a
+ <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso>
+ and any new transition option of this type
+ belongs to the new state.
+ </p>
+ </item>
+ <item>
+ <p>
+ If there are enqueued events the
<seealso marker="#state callback">state callback</seealso>
+ for the possibly new state
+ is called with the oldest enqueued event,
and we start again from the top of this list.
</p>
</item>
@@ -759,8 +773,9 @@ handle_event(_, _, State, Data) ->
after this time (in milliseconds) unless another
event arrives or has arrived
in which case this time-out is cancelled.
- Note that a retried, inserted or state time-out zero
- events counts as arrived.
+ Note that a retried or inserted event counts as arrived.
+ So does a state time-out zero event, if it was generated
+ before this timer is requested.
</p>
<p>
If the value is <c>infinity</c>, no timer is started, as
@@ -802,7 +817,7 @@ handle_event(_, _, State, Data) ->
<p>
Setting this timer while it is running will restart it with
the new time-out value. Therefore it is possible to cancel
- this timeout by setting it to <c>infinity</c>.
+ this time-out by setting it to <c>infinity</c>.
</p>
</desc>
</datatype>
@@ -1130,7 +1145,7 @@ handle_event(_, _, State, Data) ->
<c><anno>Timeout</anno></c> can also be a tuple
<c>{clean_timeout,<anno>T</anno>}</c> or
<c>{dirty_timeout,<anno>T</anno>}</c>, where
- <c><anno>T</anno></c> is the timeout time.
+ <c><anno>T</anno></c> is the time-out time.
<c>{clean_timeout,<anno>T</anno>}</c> works like
just <c>T</c> described in the note above
and uses a proxy process for <c>T &lt; infinity</c>,
@@ -1773,7 +1788,7 @@ handle_event(_, _, State, Data) ->
StateFunctionResult
</name>
<name>Module:handle_event(enter, OldState, State, Data) ->
- StateEnterResult
+ StateEnterResult(State)
</name>
<name>Module:handle_event(EventType, EventContent, State, Data) ->
HandleEventResult
@@ -1802,8 +1817,8 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-event_handler_result">event_handler_result</seealso>(<seealso marker="#type-state_name">state_name()</seealso>)
</v>
<v>
- StateEnterResult =
- <seealso marker="#type-state_enter_result">state_enter_result</seealso>(<seealso marker="#type-state">state()</seealso>)
+ StateEnterResult(State) =
+ <seealso marker="#type-state_enter_result">state_enter_result(State)</seealso>
</v>
<v>
HandleEventResult =
diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml
index e1edbadcd3..8c7270816b 100644
--- a/lib/stdlib/doc/src/maps.xml
+++ b/lib/stdlib/doc/src/maps.xml
@@ -160,7 +160,7 @@ val1
<p><em>Example:</em></p>
<code type="none">
> Map = #{"42" => value}.
-#{"42"> => value}
+#{"42" => value}
> maps:is_key("42",Map).
true
> maps:is_key(value,Map).
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 17d1ebecec..018aca90e6 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -85,7 +85,8 @@
-type state_enter() :: 'state_enter'.
-type transition_option() ::
- postpone() | hibernate() | event_timeout().
+ postpone() | hibernate() |
+ event_timeout() | state_timeout().
-type postpone() ::
%% If 'true' postpone the current event
%% and retry it when the state changes (=/=)
@@ -108,7 +109,7 @@
%% * 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.
+ %% * A state timeout is started iff 'timeout' is set.
%% * Pending events are handled or if there are
%% no pending events the server goes into receive
%% or hibernate (iff 'hibernate' is 'true')
@@ -154,12 +155,12 @@
-type handle_event_result() ::
event_handler_result(state()).
%%
--type state_enter_result(StateType) ::
+-type state_enter_result(State) ::
{'next_state', % {next_state,NextState,NewData,[]}
- State :: StateType,
+ State,
NewData :: data()} |
{'next_state', % State transition, maybe to the same state
- State :: StateType,
+ State,
NewData :: data(),
Actions :: [enter_action()] | enter_action()} |
state_callback_result(enter_action()).
@@ -231,9 +232,9 @@
-callback handle_event(
'enter',
OldState :: state(),
- State :: state(), % Current state
+ State, % Current state
Data :: data()) ->
- state_enter_result(state());
+ state_enter_result(State);
(event_type(),
EventContent :: term(),
State :: state(), % Current state
@@ -596,8 +597,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
data => Data,
postponed => P,
%% The rest of the fields are set from to the arguments to
- %% loop_event_actions/9 when it finally loops back to loop/3
- %% in loop_events_done/9
+ %% loop_event_actions/10 when it finally loops back to loop/3
+ %% in loop_events/10
%%
%% Marker for initial state, cleared immediately when used
init_state => true
@@ -605,9 +606,10 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
- StateTimer = undefined,
+ TimerRefs = #{},
+ TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, StateTimer,
+ Parent, NewDebug, NewS, TimerRefs, TimerTypes,
Events, Event, State, Data, NewActions);
{Class,Reason,Stacktrace} ->
terminate(
@@ -747,6 +749,10 @@ print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) ->
io:format(
Dev, "*DBG* ~p send ~p to ~p from state ~p~n",
[Name,Reply,To,State]);
+print_event(Dev, {terminate,Reason}, {Name,State}) ->
+ io:format(
+ Dev, "*DBG* ~p terminate ~p in state ~p~n",
+ [Name,Reason,State]);
print_event(Dev, {Tag,Event,NextState}, {Name,State}) ->
StateString =
case NextState of
@@ -806,7 +812,7 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
%% Entry point for wakeup_from_hibernate/3
loop_receive(
- Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) ->
+ Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
receive
Msg ->
case Msg of
@@ -822,18 +828,23 @@ loop_receive(
%% but this will stand out in the crash report...
terminate(
exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
- {timeout,Timer,Content}
- when Timer =/= undefined ->
- loop_receive_result(
- Parent, Debug, S, StateTimer,
- {timeout,Content});
- {timeout,StateTimer,Content}
- when StateTimer =/= undefined ->
- loop_receive_result(
- Parent, Debug, S, undefined,
- {state_timeout,Content});
+ {timeout,TimerRef,TimerMsg} ->
+ case TimerRefs of
+ #{TimerRef := TimerType} ->
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ loop_receive_result(
+ Parent, Debug, S,
+ maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimerType, TimerTypes),
+ Event);
+ _ ->
+ Event = {info,Msg},
+ loop_receive_result(
+ Parent, Debug, S,
+ TimerRefs, TimerTypes, Event)
+ end;
_ ->
- cancel_timer(Timer),
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -844,12 +855,15 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S, StateTimer, Event)
+ Parent, Debug, S,
+ TimerRefs, TimerTypes, Event)
end
end.
-loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) ->
- %% The fields 'timer', 'state_timer' and 'hibernate'
+loop_receive_result(
+ Parent, Debug, #{state := State} = S,
+ TimerRefs, TimerTypes, Event) ->
+ %% The fields 'timer_refs', 'timer_types' and 'hibernate'
%% are now invalid in state map S - they will be recalculated
%% and restored when we return to loop/3
%%
@@ -857,82 +871,196 @@ loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) ->
%% Here the queue of not yet handled events is created
Events = [],
Hibernate = false,
- loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate).
+ loop_event(
+ Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate).
-%% Process the event queue, or if it is empty
-%% loop back to loop/3 to receive a new event
-loop_events(
- Parent, Debug, S, StateTimeout,
- [Event|Events], _Timeout, State, Data, P, Hibernate) ->
+%% Entry point for handling an event, received or enqueued
+loop_event(
+ Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Events, {Type,Content} = Event, Hibernate) ->
%%
- %% If there was an event timer requested we just ignore that
- %% since we have events to handle which cancels the timer
- loop_event(
- Parent, Debug, S, StateTimeout,
- Events, Event, State, Data, P, Hibernate);
-loop_events(
- Parent, Debug, S, {state_timeout,Time,EventContent},
- [] = Events, Timeout, State, Data, P, Hibernate) ->
- if
- Time =:= 0 ->
- %% Simulate an immediate timeout
- %% so we do not get the timeout message
- %% after any received event
- %%
- %% This faked event will cancel
- %& any not yet started event timer
- Event = {state_timeout,EventContent},
- StateTimer = undefined,
- loop_event(
- Parent, Debug, S, StateTimer,
- Events, Event, State, Data, P, Hibernate);
- true ->
- StateTimer = erlang:start_timer(Time, self(), EventContent),
- loop_events(
- Parent, Debug, S, StateTimer,
- Events, Timeout, State, Data, P, Hibernate)
- end;
-loop_events(
- Parent, Debug, S, StateTimer,
- [] = Events, Timeout, State, Data, P, Hibernate) ->
- case Timeout of
- {timeout,0,EventContent} ->
- %% Simulate an immediate timeout
- %% so we do not get the timeout message
- %% after any received event
- %%
- Event = {timeout,EventContent},
- loop_event(
- Parent, Debug, S, StateTimer,
- Events, Event, State, Data, P, Hibernate);
- {timeout,Time,EventContent} ->
- Timer = erlang:start_timer(Time, self(), EventContent),
- loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer);
- undefined ->
- %% No event timeout has been requested
- Timer = undefined,
- loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer)
+ %% If Hibernate is true here it can only be
+ %% because it was set from an event action
+ %% and we did not go into hibernation since there
+ %% were events in queue, so we do what the user
+ %% might rely on i.e collect garbage which
+ %% would have happened if we actually hibernated
+ %% and immediately was awakened
+ Hibernate andalso garbage_collect(),
+ case call_state_function(S, Type, Content, State, Data) of
+ {ok,Result,NewS} ->
+ %% Cancel event timeout
+ {NewTimerRefs,NewTimerTypes} =
+ cancel_timer_by_type(
+ timeout, TimerRefs, TimerTypes),
+ {NewData,NextState,Actions} =
+ parse_event_result(
+ true, Debug, NewS, Result,
+ Events, Event, State, Data),
+ loop_event_actions(
+ Parent, Debug, S, NewTimerRefs, NewTimerTypes,
+ Events, Event, NextState, NewData, Actions);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace, Debug, S, [Event|Events])
end.
-%% Back to the top
-loop_events_done(
- Parent, Debug, S, StateTimer,
- State, Data, P, Hibernate, Timer) ->
+loop_event_actions(
+ Parent, Debug,
+ #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData, Actions) ->
+ case parse_actions(Debug, S, State, Actions) of
+ {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
+ if
+ StateEnter, NextState =/= State ->
+ loop_event_enter(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ StateEnter ->
+ case maps:is_key(init_state, S) of
+ true ->
+ %% Avoid infinite loop in initial state
+ %% with state entry events
+ NewS = maps:remove(init_state, S),
+ loop_event_enter(
+ Parent, NewDebug, NewS, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ false ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR)
+ end;
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR)
+ end;
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{data := NewData}, [Event|Events])
+ end.
+
+loop_event_enter(
+ Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ case call_state_function(S, enter, State, NextState, NewData) of
+ {ok,Result,NewS} ->
+ {NewerData,_,Actions} =
+ parse_event_result(
+ false, Debug, NewS, Result,
+ Events, Event, NextState, NewData),
+ loop_event_enter_actions(
+ Parent, Debug, NewS, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
+ end.
+
+loop_event_enter_actions(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ case
+ parse_enter_actions(
+ Debug, S, NextState, Actions,
+ Hibernate, TimeoutsR)
+ of
+ {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
+ loop_event_result(
+ Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ {Class,Reason,Stacktrace} ->
+ terminate(
+ Class, Reason, Stacktrace,
+ Debug, S#{state := NextState, data := NewData},
+ [Event|Events])
+ end.
+
+loop_event_result(
+ Parent, Debug,
+ #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
+ Events, Event, NextState, NewData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ %%
+ %% All options have been collected and next_events are buffered.
+ %% Do the actual state transition.
+ %%
+ {NewDebug,P_1} = % Move current event to postponed if Postpone
+ case Postpone of
+ true ->
+ {sys_debug(Debug, S, State, {postpone,Event,State}),
+ [Event|P_0]};
+ false ->
+ {sys_debug(Debug, S, State, {consume,Event,State}),
+ P_0}
+ end,
+ {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} =
+ %% Move all postponed events to queue and cancel the
+ %% state timeout if the state changes
+ if
+ NextState =:= State ->
+ {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ true ->
+ {lists:reverse(P_1, Events),[],
+ cancel_timer_by_type(
+ state_timeout, TimerRefs_0, TimerTypes_0)}
+ end,
+ {TimerRefs_2,TimerTypes_2,TimeoutEvents} =
+ %% Stop and start timers non-event timers
+ parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR),
+ %% Place next events last in reversed queue
+ Events_2R = lists:reverse(Events_1, NextEventsR),
+ %% Enqueue immediate timeout events and start event timer
+ {NewTimerRefs,NewTimerTypes,Events_3R} =
+ process_timeout_events(
+ TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R),
+ NewEvents = lists:reverse(Events_3R),
+ loop_events(
+ Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
+ NewEvents, Hibernate, NextState, NewData, NewP).
+
+%% Loop until out of enqueued events
+%%
+loop_events(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ [] = _Events, Hibernate, State, Data, P) ->
+ %% Update S and loop back to loop/3 to receive a new event
NewS =
S#{
state := State,
data := Data,
postponed := P,
hibernate => Hibernate,
- timer => Timer,
- state_timer => StateTimer},
- loop(Parent, Debug, NewS).
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes},
+ loop(Parent, Debug, NewS);
+loop_events(
+ Parent, Debug, S, TimerRefs, TimerTypes,
+ [Event|Events], Hibernate, State, Data, P) ->
+ %% Update S and continue with enqueued events
+ NewS =
+ S#{
+ state := State,
+ data := Data,
+ postponed := P},
+ loop_event(
+ Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
+
+%%---------------------------------------------------------------------------
+%% Server loop helpers
call_callback_mode(#{module := Module} = S) ->
try Module:callback_mode() of
@@ -996,6 +1124,7 @@ parse_callback_mode([H|T], CBMode, StateEnter) ->
parse_callback_mode(_, _CBMode, StateEnter) ->
{undefined,StateEnter}.
+
call_state_function(
#{callback_mode := undefined} = S,
Type, Content, State, Data) ->
@@ -1061,42 +1190,6 @@ call_state_function(
{Class,Reason,erlang:get_stacktrace()}
end.
-%% Update S and continue
-loop_event(
- Parent, Debug, S, StateTimer,
- Events, Event, State, Data, P, Hibernate) ->
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P},
- loop_event(Parent, Debug, NewS, StateTimer, Events, Event, Hibernate).
-
-loop_event(
- Parent, Debug, #{state := State, data := Data} = S, StateTimer,
- Events, {Type,Content} = Event, Hibernate) ->
- %%
- %% If Hibernate is true here it can only be
- %% because it was set from an event action
- %% and we did not go into hibernation since there
- %% were events in queue, so we do what the user
- %% might rely on i.e collect garbage which
- %% would have happened if we actually hibernated
- %% and immediately was awakened
- Hibernate andalso garbage_collect(),
- case call_state_function(S, Type, Content, State, Data) of
- {ok,Result,NewS} ->
- {NewData,NextState,Actions} =
- parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
- loop_event_actions(
- Parent, Debug, S, StateTimer,
- Events, Event, NextState, NewData, Actions);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
- end.
%% Interpret all callback return variants
parse_event_result(
@@ -1146,32 +1239,32 @@ parse_event_result(
Debug, S, [Event|Events])
end.
+
parse_enter_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout) ->
+ Hibernate, TimeoutsR) ->
Postpone = forbidden,
- NextEvents = forbidden,
+ NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
+ Hibernate, TimeoutsR, Postpone, NextEventsR).
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- Timeout = undefined,
- StateTimeout = undefined,
+ TimeoutsR = [],
Postpone = false,
- NextEvents = [],
+ NextEventsR = [],
parse_actions(
Debug, S, State, listify(Actions),
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents).
+ Hibernate, TimeoutsR, Postpone, NextEventsR).
%%
parse_actions(
Debug, _S, _State, [],
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
- {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents};
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
+ {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR};
parse_actions(
Debug, S, State, [Action|Actions],
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case Action of
%% Actual actions
{reply,From,Reply} ->
@@ -1180,8 +1273,7 @@ parse_actions(
NewDebug = do_reply(Debug, S, State, From, Reply),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, StateTimeout,
- Postpone, NextEvents);
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
false ->
{error,
{bad_action_from_state_function,Action},
@@ -1191,7 +1283,7 @@ parse_actions(
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
- NewHibernate, Timeout, StateTimeout, Postpone, NextEvents);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
{hibernate,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1199,43 +1291,44 @@ parse_actions(
hibernate ->
parse_actions(
Debug, S, State, Actions,
- true, Timeout, StateTimeout, Postpone, NextEvents);
- {state_timeout,Time,_} = NewStateTimeout
+ true, TimeoutsR, Postpone, NextEventsR);
+ {state_timeout,Time,_} = StateTimeout
when is_integer(Time), Time >= 0;
Time =:= infinity ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents);
+ Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
{state_timeout,_,_} ->
{error,
{bad_action_from_state_function,Action},
?STACKTRACE()};
- {timeout,infinity,_} -> % Clear timer - it will never trigger
+ {timeout,infinity,_} ->
+ %% Ignore - timeout will never happen and already cancelled
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, StateTimeout, Postpone, NextEvents);
- {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
+ {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
+ Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
{timeout,_,_} ->
{error,
{bad_action_from_state_function,Action},
?STACKTRACE()};
- infinity -> % Clear timer - it will never trigger
+ infinity -> % Ignore - timeout will never happen
parse_actions(
Debug, S, State, Actions,
- Hibernate, undefined, StateTimeout, Postpone, NextEvents);
+ Hibernate, TimeoutsR, Postpone, NextEventsR);
Time when is_integer(Time), Time >= 0 ->
- NewTimeout = {timeout,Time,Time},
+ Timeout = {timeout,Time,Time},
parse_actions(
Debug, S, State, Actions,
- Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents);
+ Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
{postpone,_} ->
{error,
{bad_action_from_state_function,Action},
@@ -1243,16 +1336,16 @@ parse_actions(
postpone when Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
- Hibernate, Timeout, StateTimeout, true, NextEvents);
+ Hibernate, TimeoutsR, true, NextEventsR);
{next_event,Type,Content} ->
case event_type(Type) of
- true when NextEvents =/= forbidden ->
+ true when NextEventsR =/= forbidden ->
NewDebug =
sys_debug(Debug, S, State, {in,{Type,Content}}),
parse_actions(
NewDebug, S, State, Actions,
- Hibernate, Timeout, StateTimeout,
- Postpone, [{Type,Content}|NextEvents]);
+ Hibernate, TimeoutsR, Postpone,
+ [{Type,Content}|NextEventsR]);
_ ->
{error,
{bad_action_from_state_function,Action},
@@ -1264,158 +1357,92 @@ parse_actions(
?STACKTRACE()}
end.
-loop_event_actions(
- Parent, Debug,
- #{state := State, state_enter := StateEnter} = S, StateTimer,
- Events, Event, NextState, NewData, Actions) ->
- case parse_actions(Debug, S, State, Actions) of
- {ok,NewDebug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents} ->
+
+%% Stop and start timers as well as create timeout zero events
+%% and pending event timer
+%%
+%% Stop and start timers non-event timers
+parse_timers(TimerRefs, TimerTypes, TimeoutsR) ->
+ parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []).
+%%
+parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,TimeoutEvents};
+parse_timers(
+ TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
+ {TimerType,Time,TimerMsg} = Timeout,
+ case Seen of
+ #{TimerType := _} ->
+ %% Type seen before - ignore
+ parse_timers(
+ TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ #{} ->
+ %% Unseen type - handle
+ NewSeen = Seen#{TimerType => true},
+ %% Cancel any running timer
+ {NewTimerRefs,NewTimerTypes} =
+ cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
if
- StateEnter, NextState =/= State ->
- loop_event_enter(
- Parent, NewDebug, S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents);
- StateEnter ->
- case maps:is_key(init_state, S) of
- true ->
- %% Avoid infinite loop in initial state
- %% with state entry events
- NewS = maps:remove(init_state, S),
- loop_event_enter(
- Parent, NewDebug, NewS, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout,
- Postpone, NextEvents);
- false ->
- loop_event_result(
- Parent, NewDebug, S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout,
- Postpone, NextEvents)
- end;
+ Time =:= infinity ->
+ %% Ignore - timer will never fire
+ parse_timers(
+ NewTimerRefs, NewTimerTypes, TimeoutsR,
+ NewSeen, TimeoutEvents);
+ TimerType =:= timeout ->
+ %% Handle event timer later
+ parse_timers(
+ NewTimerRefs, NewTimerTypes, TimeoutsR,
+ NewSeen, [Timeout|TimeoutEvents]);
+ Time =:= 0 ->
+ %% Handle zero time timeouts later
+ TimeoutEvent = {TimerType,TimerMsg},
+ parse_timers(
+ NewTimerRefs, NewTimerTypes, TimeoutsR,
+ NewSeen, [TimeoutEvent|TimeoutEvents]);
true ->
- loop_event_result(
- Parent, NewDebug, S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents)
- end;
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
+ %% Start a new timer
+ TimerRef = erlang:start_timer(Time, self(), TimerMsg),
+ parse_timers(
+ NewTimerRefs#{TimerRef => TimerType},
+ NewTimerTypes#{TimerType => TimerRef},
+ TimeoutsR, NewSeen, TimeoutEvents)
+ end
end.
-loop_event_enter(
- Parent, Debug, #{state := State} = S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
- case call_state_function(S, enter, State, NextState, NewData) of
- {ok,Result,NewS} ->
- {NewerData,_,Actions} =
- parse_event_result(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, StateTimer,
- Events, Event, NextState, NewerData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
- [Event|Events])
- end.
+%% Enqueue immediate timeout events and start event timer
+process_timeout_events(TimerRefs, TimerTypes, [], EventsR) ->
+ {TimerRefs, TimerTypes, EventsR};
+process_timeout_events(
+ TimerRefs, TimerTypes,
+ [{timeout,0,TimerMsg}|TimeoutEvents], []) ->
+ %% No enqueued events - insert a timeout zero event
+ TimeoutEvent = {timeout,TimerMsg},
+ process_timeout_events(
+ TimerRefs, TimerTypes,
+ TimeoutEvents, [TimeoutEvent]);
+process_timeout_events(
+ TimerRefs, TimerTypes,
+ [{timeout,Time,TimerMsg}], []) ->
+ %% No enqueued events - start event timer
+ TimerRef = erlang:start_timer(Time, self(), TimerMsg),
+ process_timeout_events(
+ TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef},
+ [], []);
+process_timeout_events(
+ TimerRefs, TimerTypes,
+ [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) ->
+ %% There will be some other event so optimize by not starting
+ %% an event timer to just have to cancel it again
+ process_timeout_events(
+ TimerRefs, TimerTypes,
+ TimeoutEvents, EventsR);
+process_timeout_events(
+ TimerRefs, TimerTypes,
+ [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) ->
+ process_timeout_events(
+ TimerRefs, TimerTypes,
+ TimeoutEvents, [TimeoutEvent|EventsR]).
-loop_event_enter_actions(
- Parent, Debug, S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions) ->
- case
- parse_enter_actions(
- Debug, S, NextState, Actions,
- Hibernate, Timeout, StateTimeout)
- of
- {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, StateTimer,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents);
- {Class,Reason,Stacktrace} ->
- terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
- [Event|Events])
- end.
-loop_event_result(
- Parent, Debug,
- #{state := State, postponed := P_0} = S, StateTimer,
- Events, Event, NextState, NewData,
- Hibernate, Timeout, StateTimeout, Postpone, NextEvents) ->
- %%
- %% All options have been collected and next_events are buffered.
- %% Do the actual state transition.
- %%
- NewStateTimeout =
- case StateTimeout of
- {state_timeout,Time,_} ->
- %% New timeout -> cancel timer
- case StateTimer of
- {state_timeout,_,_} ->
- ok;
- _ ->
- cancel_timer(StateTimer)
- end,
- case Time of
- infinity ->
- undefined;
- _ ->
- StateTimeout
- end;
- undefined when NextState =/= State ->
- %% State change -> cancel timer
- case StateTimer of
- {state_timeout,_,_} ->
- ok;
- _ ->
- cancel_timer(StateTimer)
- end,
- undefined;
- undefined ->
- StateTimer
- end,
- %%
- P_1 = % Move current event to postponed if Postpone
- case Postpone of
- true ->
- [Event|P_0];
- false ->
- P_0
- end,
- {Events_1,NewP} = % Move all postponed events to queue if state change
- if
- NextState =:= State ->
- {Events,P_1};
- true ->
- {lists:reverse(P_1, Events),[]}
- end,
- %% Place next events first in queue
- NewEvents = lists:reverse(NextEvents, Events_1),
- %%
- NewDebug =
- sys_debug(
- Debug, S, State,
- case Postpone of
- true ->
- {postpone,Event,State};
- false ->
- {consume,Event,State}
- end),
- %%
- loop_events(
- Parent, NewDebug, S, NewStateTimeout,
- NewEvents, Timeout, NextState, NewData, NewP, Hibernate).
%%---------------------------------------------------------------------------
%% Server helpers
@@ -1474,16 +1501,20 @@ terminate(
sys:print_log(Debug),
erlang:raise(C, R, ST)
end,
- case Reason of
- normal -> ok;
- shutdown -> ok;
- {shutdown,_} -> ok;
- _ ->
- error_info(
- Class, Reason, Stacktrace, S, Q, P,
- format_status(terminate, get(), S)),
- sys:print_log(Debug)
- end,
+ _ =
+ case Reason of
+ normal ->
+ sys_debug(Debug, S, State, {terminate,Reason});
+ shutdown ->
+ sys_debug(Debug, S, State, {terminate,Reason});
+ {shutdown,_} ->
+ sys_debug(Debug, S, State, {terminate,Reason});
+ _ ->
+ error_info(
+ Class, Reason, Stacktrace, S, Q, P,
+ format_status(terminate, get(), S)),
+ sys:print_log(Debug)
+ end,
case Stacktrace of
[] ->
erlang:Class(Reason);
@@ -1605,8 +1636,19 @@ listify(Item) when is_list(Item) ->
listify(Item) ->
[Item].
-cancel_timer(undefined) ->
- ok;
+%% Cancel timer if running, otherwise no op
+cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ cancel_timer(TimerRef),
+ {maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimerType, TimerTypes)};
+ #{} ->
+ {TimerRefs,TimerTypes}
+ end.
+
+%%cancel_timer(undefined) ->
+%% ok;
cancel_timer(TRef) ->
case erlang:cancel_timer(TRef) of
false ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 28f9ab81fe..119546be98 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -742,26 +742,40 @@ state_timeout(_Config) ->
%% Verify that {state_timeout,0,_}
%% comes after next_event and that
%% {timeout,0,_} is cancelled by
- %% {state_timeout,0,_}
+ %% pending {state_timeout,0,_}
{keep_state, {ok,2,Data},
[{timeout,0,3}]};
- (state_timeout, 2, {ok,2,{Time,From}}) ->
- {next_state, state3, 3,
+ (state_timeout, 2, {ok,2,Data}) ->
+ %% Verify that timeout 0's are processed
+ %% in order
+ {keep_state, {ok,3,Data},
+ [{timeout,0,4},{state_timeout,0,5}]};
+ (timeout, 4, {ok,3,Data}) ->
+ %% Verify that timeout 0 is cancelled by
+ %% enqueued state_timeout 0 and that
+ %% multiple state_timeout 0 can be enqueued
+ {keep_state, {ok,4,Data},
+ [{state_timeout,0,6},{timeout,0,7}]};
+ (state_timeout, 5, {ok,4,Data}) ->
+ {keep_state, {ok,5,Data}};
+ (state_timeout, 6, {ok,5,{Time,From}}) ->
+ {next_state, state3, 6,
[{reply,From,ok},
- {state_timeout,Time,3}]}
+ {state_timeout,Time,8}]}
end,
state3 =>
fun
- (info, message_to_self, 3) ->
- {keep_state, '3'};
- ({call,From}, check, '3') ->
+ (info, message_to_self, 6) ->
+ {keep_state, 7};
+ ({call,From}, check, 7) ->
{keep_state, From};
- (state_timeout, 3, From) ->
+ (state_timeout, 8, From) ->
{stop_and_reply, normal,
{reply,From,ok}}
end},
{ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine,[]}, []),
+ sys:trace(STM, true),
TRef = erlang:start_timer(1000, self(), kull),
ok = gen_statem:call(STM, {go,500}),
ok = gen_statem:call(STM, check),
diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile
index e1b195ef97..35c93ba4ed 100644
--- a/lib/tools/emacs/Makefile
+++ b/lib/tools/emacs/Makefile
@@ -38,6 +38,7 @@ MAN_FILES= \
tags.3
EMACS_FILES= \
+ erldoc \
erlang-skels \
erlang-skels-old \
erlang_appwiz \
diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el
index f9a6d24b2c..160057e179 100644
--- a/lib/tools/emacs/erlang-start.el
+++ b/lib/tools/emacs/erlang-start.el
@@ -78,9 +78,23 @@
(autoload 'erlang-find-tag-other-window "erlang"
"Like `find-tag-other-window'. Capable of retreiving Erlang modules.")
+;;
+;; Declare functions in "erlang-edoc.el".
+;;
+
(autoload 'erlang-edoc-mode "erlang-edoc" "Toggle Erlang-Edoc mode on or off." t)
;;
+;; Declare functions in "erldoc.el".
+;;
+
+(autoload 'erldoc-browse "erldoc" "\n\n(fn MFA)" t nil)
+(autoload 'erldoc-browse-topic "erldoc" "\n\n(fn TOPIC)" t nil)
+(autoload 'erldoc-apropos "erldoc" "\n\n(fn PATTERN)" t nil)
+(autoload 'erldoc-eldoc-function "erldoc" "\
+A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil)
+
+;;
;; Associate files extensions ".erl" and ".hrl" with Erlang mode.
;;
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index cc22903e7f..40f0bb7f80 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1440,6 +1440,11 @@ Other commands:
(erlang-skel-init)
(when (fboundp 'tempo-use-tag-list)
(tempo-use-tag-list 'erlang-tempo-tags))
+ (when (and (fboundp 'add-function) (fboundp 'erldoc-eldoc-function))
+ (or eldoc-documentation-function
+ (setq-local eldoc-documentation-function #'ignore))
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'erldoc-eldoc-function))
(run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)))
diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el
new file mode 100644
index 0000000000..cb355374d9
--- /dev/null
+++ b/lib/tools/emacs/erldoc.el
@@ -0,0 +1,508 @@
+;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*-
+
+;; %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%
+
+;;; Commentary:
+
+;; Crawl Erlang/OTP HTML documentation and generate lookup tables.
+;;
+;; This package depends on `cl-lib', `pcase' and
+;; `libxml-parse-html-region'; emacs 24+ compiled with libxml2 should
+;; work. On emacs 24.1 and 24.2 do `M-x package-install RET cl-lib
+;; RET' to install `cl-lib'.
+;;
+;; Please customise `erldoc-man-index' to point to your local OTP
+;; documentation.
+;;
+;; To use:
+;;
+;; (define-key help-map "u" 'erldoc-browse)
+;; (define-key help-map "t" 'erldoc-browse-topic)
+;; (define-key help-map "a" 'erldoc-apropos)
+;;
+;; Note: these commands trigger indexing OTP documentation on first
+;; run with cache to disk which may take 1-2 minutes.
+
+
+;;; Examples:
+
+;; 1. `M-x erldoc-browse RET erlang:integer_to_binary/2 RET' opens the
+;; `erlang' manual anchored on the entry for `integer_to_binary/2'.
+;;
+;; 2. `M-x erldoc-apropos RET first RET' list all MFAs matching
+;; substring `first'.
+;;
+;; 3. `M-x erldoc-browse-topic RET efficiency_guide#Introduction RET'
+;; opens chapter `Introduction' of the `Efficiency Guide' in the
+;; browser.
+
+;;; History:
+
+;; Written in December 2013 as a temporary solution to help me browse
+;; the rich Erlang/OTP documentation. Three years on I find myself
+;; still using it every day. - Leo (2016)
+
+;;; Code:
+
+(eval-when-compile (require 'url-parse))
+(require 'cl-lib)
+(require 'erlang)
+
+(eval-and-compile ;for emacs < 24.3
+ (or (fboundp 'user-error) (defalias 'user-error 'error)))
+
+(defgroup erldoc nil
+ "Browse Erlang document."
+ :group 'help)
+
+(defcustom erldoc-man-index "http://www.erlang.org/doc/man_index.html"
+ "The URL to the man_index.html page.
+Note it is advisable to customise this to a local URL for example
+`file:///usr/local/19.1/lib/erlang/doc/man_index.html' to speed
+up the indexing."
+ :type 'string
+ :group 'erldoc)
+
+(defcustom erldoc-verify-man-path nil
+ "If non-nil verify man path existence for `file://'."
+ :type 'boolean
+ :group 'erldoc)
+
+(defcustom erldoc-output-file (locate-user-emacs-file "cache/erldoc")
+ "File to store the parsed results."
+ :type 'file
+ :group 'erldoc)
+
+(defun erldoc-strip-string (s)
+ (let* ((re "[ \t\n\r\f\v\u00a0]+")
+ (from (if (string-match (concat "\\`" re) s) (match-end 0) 0))
+ (to (and (string-match (concat re "\\'") s) (match-beginning 0))))
+ (substring s from (and to (max to from)))))
+
+;; Note: don't know how to get the BASE-URL to
+;; `libxml-parse-html-region' to work.
+(defun erldoc-expand-url (url base-url)
+ (if (url-type (url-generic-parse-url url))
+ url
+ (let* ((base (url-generic-parse-url base-url))
+ (dir (directory-file-name (file-name-directory (url-filename base)))))
+ (setf (url-filename base) (expand-file-name url dir))
+ (url-recreate-url base))))
+
+(defun erldoc-parse-html (url)
+ (with-temp-buffer
+ (url-insert-file-contents url)
+ (libxml-parse-html-region (point-min) (point-max))))
+
+(defalias 'erldoc-dom-text-node-p #'stringp)
+
+(defun erldoc-dom-attributes (dom)
+ (and (not (erldoc-dom-text-node-p dom)) (cadr dom)))
+
+(defun erldoc-dom-get-attribute (dom attrib-name)
+ (cdr (assq attrib-name (erldoc-dom-attributes dom))))
+
+(defun erldoc-dom-children (dom)
+ (and (not (erldoc-dom-text-node-p dom)) (cddr dom)))
+
+(defun erldoc-dom-get-text (dom)
+ (let ((text (car (last (erldoc-dom-children dom)))))
+ (and (erldoc-dom-text-node-p text) text)))
+
+(defvar erldoc-dom-walk-parent nil)
+(defvar erldoc-dom-walk-siblings nil)
+
+(defun erldoc-dom-walk (dom k)
+ (funcall k dom)
+ (let ((erldoc-dom-walk-parent dom)
+ (erldoc-dom-walk-siblings (unless (erldoc-dom-text-node-p dom)
+ (cddr dom))))
+ (dolist (child erldoc-dom-walk-siblings)
+ (erldoc-dom-walk child k))))
+
+(defun erldoc-dom-get-element (dom element-name)
+ (catch 'return
+ (erldoc-dom-walk dom (lambda (d)
+ (when (eq (car-safe d) element-name)
+ (throw 'return d))))))
+
+(defun erldoc-dom-get-element-by-id (dom id)
+ (catch 'return
+ (erldoc-dom-walk dom (lambda (d)
+ (when (equal (erldoc-dom-get-attribute d 'id) id)
+ (throw 'return d))))))
+
+(defun erldoc-dom-get-elements-by-id (dom id)
+ (let (result)
+ (erldoc-dom-walk dom (lambda (d)
+ (when (equal (erldoc-dom-get-attribute d 'id) id)
+ (push d result))))
+ (nreverse result)))
+
+(defun erldoc-fix-path (url)
+ (if (and erldoc-verify-man-path
+ ;; Could only verify local files
+ (equal (url-type (url-generic-parse-url url)) "file"))
+ (let* ((obj (url-generic-parse-url url))
+ (new (car (file-expand-wildcards
+ (replace-regexp-in-string
+ "-[0-9]+\\(?:[.][0-9]+\\)*" "*"
+ (url-filename obj))))))
+ (or new (error "File %s does not exist" (url-filename obj)))
+ (setf (url-filename obj) new)
+ (url-recreate-url obj))
+ url))
+
+(defun erldoc-parse-man-index (url)
+ (let ((table (erldoc-dom-get-element (erldoc-parse-html url) 'table))
+ (mans))
+ (erldoc-dom-walk
+ table
+ (lambda (d)
+ (when (eq (car-safe d) 'a)
+ (let ((href (erldoc-dom-get-attribute d 'href)))
+ (when (and href (not (string-match-p "index\\.html\\'" href)))
+ (with-demoted-errors "erldoc-parse-man-index: %S"
+ (push (cons (erldoc-dom-get-text d)
+ (erldoc-fix-path (erldoc-expand-url href url)))
+ mans)))))))
+ (nreverse mans)))
+
+(defun erldoc-parse-man (man)
+ (let ((dom (erldoc-parse-html (cdr man)))
+ (table (make-hash-table :test #'equal)))
+ (erldoc-dom-walk
+ (erldoc-dom-get-element-by-id dom "loadscrollpos")
+ (lambda (d)
+ (let ((href (erldoc-dom-get-attribute d 'href)))
+ (when (and href (string-match "#" href))
+ (puthash (substring href (match-end 0))
+ (list (concat (car man) ":" (erldoc-strip-string
+ (erldoc-dom-get-text d)))
+ (erldoc-expand-url href (cdr man)))
+ table)))))
+ (let ((span-content
+ (lambda (span)
+ (let ((texts))
+ (erldoc-dom-walk span
+ (lambda (d)
+ (and (erldoc-dom-text-node-p d)
+ (push (erldoc-strip-string d) texts))))
+ (and texts (mapconcat 'identity (nreverse texts) " ")))))
+ entries)
+ (erldoc-dom-walk
+ dom
+ (lambda (d)
+ ;; Get the full function signature.
+ (when (and (eq (car-safe d) 'a)
+ (gethash (erldoc-dom-get-attribute d 'name) table))
+ (push (append (gethash (erldoc-dom-get-attribute d 'name) table)
+ (list (funcall span-content
+ (or (erldoc-dom-get-element d 'span)
+ (cadr (memq d erldoc-dom-walk-siblings))))))
+ entries))
+ ;; Get data types
+ (when (and (eq (car-safe d) 'a)
+ (string-prefix-p "type-"
+ (or (erldoc-dom-get-attribute d 'name) "")))
+ (push (list (concat (car man) ":" (funcall span-content d))
+ (concat (cdr man) "#" (erldoc-dom-get-attribute d 'name))
+ (funcall span-content erldoc-dom-walk-parent))
+ entries))))
+ entries)))
+
+(defun erldoc-parse-all (man-index output &optional json)
+ (let* ((output (expand-file-name output))
+ (table (make-hash-table :size 11503 :test #'equal))
+ (mans (erldoc-parse-man-index man-index))
+ (progress 1)
+ (reporter (make-progress-reporter "Parsing Erlang/OTP documentation"
+ progress (length mans)))
+ fails all)
+ (dolist (man mans)
+ (condition-case err
+ (push (erldoc-parse-man man) all)
+ (error (push (error-message-string err) fails)))
+ (accept-process-output nil 0.01)
+ (progress-reporter-update reporter (cl-incf progress)))
+ (when fails
+ (display-warning 'erldoc-parse-all
+ (format "\n\n%s" (mapconcat #'identity fails "\n"))
+ :error))
+ (progress-reporter-done reporter)
+ (mapc (lambda (x) (puthash (car x) (cdr x) table))
+ (apply #'nconc (nreverse all)))
+ (with-temp-buffer
+ (if (not json)
+ (pp table (current-buffer))
+ (eval-and-compile (require 'json))
+ (let ((json-encoding-pretty-print t))
+ (insert (json-encode table))))
+ (unless (file-directory-p (file-name-directory output))
+ (make-directory (file-name-directory output) t))
+ (write-region nil nil output nil nil nil 'ask))))
+
+(defun erldoc-otp-release ()
+ "Get the otp release version (as string) or nil if not found."
+ (let ((otp (erldoc-dom-get-text
+ (erldoc-dom-get-element
+ (erldoc-parse-html
+ (erldoc-expand-url "index.html" erldoc-man-index))
+ 'title))))
+ (and (string-match "[0-9.]+\\'" otp) (match-string 0 otp))))
+
+(defvar erldoc-browse-history nil)
+(defvar erldoc-lookup-table nil)
+
+(defun erldoc-lookup-table ()
+ (or erldoc-lookup-table
+ (progn
+ (unless (file-exists-p erldoc-output-file)
+ (let ((of (pcase (erldoc-otp-release)
+ (`nil erldoc-output-file)
+ (ver (concat erldoc-output-file "-" ver)))))
+ (unless (file-exists-p of)
+ (erldoc-parse-all erldoc-man-index of))
+ (unless (string= erldoc-output-file of)
+ (make-symbolic-link of erldoc-output-file))))
+ (setq erldoc-lookup-table
+ (with-temp-buffer
+ (insert-file-contents erldoc-output-file)
+ (read (current-buffer)))))))
+
+(defun erldoc-best-matches (mfa)
+ (pcase mfa
+ ((and `(,m ,f) (let a (erlang-get-function-arity)))
+ (let ((mfa (format "%s:%s/%s" m f a)))
+ (cond ((gethash mfa (erldoc-lookup-table)) (list mfa))
+ (m (all-completions (concat m ":" f "/") (erldoc-lookup-table)))
+ (t (let* ((mod (erlang-get-module))
+ (mf1 (and mod (concat mod ":" f "/")))
+ (mf2 (concat "erlang:" f "/"))
+ (re (concat ":" (regexp-quote f) "/")))
+ (or (and mf1 (all-completions mf1 (erldoc-lookup-table)))
+ (all-completions mf2 (erldoc-lookup-table))
+ (cl-loop for k being the hash-keys of (erldoc-lookup-table)
+ when (string-match-p re k)
+ collect k)))))))))
+
+;;;###autoload
+(defun erldoc-browse (mfa)
+ (interactive
+ (let ((default
+ ;; `erlang-mode-syntax-table' is lazily initialised.
+ (with-syntax-table (or erlang-mode-syntax-table (standard-syntax-table))
+ (ignore-errors
+ (erldoc-best-matches
+ (or (erlang-get-function-under-point)
+ (save-excursion
+ (goto-char (or (cadr (syntax-ppss)) (point)))
+ (erlang-get-function-under-point))))))))
+ (list (completing-read (format (if default "Function {%d %s} (default %s): "
+ "Function: ")
+ (length default)
+ (if (= (length default) 1) "guess" "guesses")
+ (car default))
+ (erldoc-lookup-table)
+ nil t nil 'erldoc-browse-history default))))
+ (or (stringp mfa)
+ (signal 'wrong-type-argument (list 'string mfa 'mfa)))
+ (browse-url (or (car (gethash mfa (erldoc-lookup-table)))
+ (user-error "No documentation for %s" mfa))))
+
+;;;###autoload
+(defun erldoc-apropos (pattern)
+ (interactive "sPattern: ")
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (princ (concat "Erldoc apropos pattern: " pattern "\n\n"))
+ (maphash (lambda (k v)
+ (when (string-match-p pattern k)
+ (insert-text-button k :type 'help-url
+ 'help-args (list (car v)))
+ (insert "\n")))
+ (erldoc-lookup-table)))))
+
+(defun erldoc-tokenize-signature (sig)
+ ;; Divide SIG into (MF ARGLIST RETTYPE)
+ (let ((from (if (string-match "\\`.+?(" sig)
+ (1- (match-end 0))
+ 0))
+ (to (and (string-match "\\s-*->\\s-*.*?\\'" sig) (match-beginning 0))))
+ (list (erldoc-strip-string (substring sig 0 from))
+ (erldoc-strip-string (substring sig from (and to (max from to))))
+ (and to (erldoc-strip-string (substring sig to))))))
+
+(defun erldoc-format-signature (mod fn)
+ (when (and mod fn (or erldoc-lookup-table
+ (file-exists-p erldoc-output-file)))
+ (let ((re (concat "\\`" mod ":" fn "/\\([0-9]+\\)\\'"))
+ (sigs))
+ (maphash (lambda (k v)
+ (when (string-match re k)
+ (push (cons (string-to-number (match-string 1 k))
+ (cdr (erldoc-tokenize-signature (cadr v))))
+ sigs)))
+ (erldoc-lookup-table))
+ (when sigs
+ ;; Mostly single return type but there are exceptions such as
+ ;; `beam_lib:chunks/2,3'.
+ (let ((single-rettype
+ (cl-reduce (lambda (x1 x2) (and x1 x2 (equal x1 x2) x1))
+ sigs :key #'cl-caddr))
+ (sigs (sort sigs #'car-less-than-car)))
+ (if single-rettype
+ (concat mod ":" fn (mapconcat #'cadr sigs " | ") " " single-rettype)
+ (mapconcat (lambda (x) (concat mod ":" fn (nth 1 x) " " (nth 2 x)))
+ sigs "\n")))))))
+
+;;;###autoload
+(defun erldoc-eldoc-function ()
+ "A function suitable for `eldoc-documentation-function'."
+ (save-excursion
+ (pcase (erlang-get-function-under-point)
+ (`(,_ nil) )
+ (`(nil ,fn) (erldoc-format-signature "erlang" fn))
+ (`(,mod ,fn) (erldoc-format-signature mod fn)))))
+
+(defun erldoc-parse-eeps-index ()
+ (let* ((url "http://www.erlang.org/eeps/")
+ (table (catch 'return
+ (erldoc-dom-walk (erldoc-parse-html url)
+ (lambda (d)
+ (and (eq (car-safe d) 'table)
+ (equal (erldoc-dom-get-attribute d 'summary)
+ "Numerical Index of EEPs")
+ (throw 'return d))))))
+ (fix-title (lambda (title)
+ (replace-regexp-in-string
+ "`` *" "" (replace-regexp-in-string " *``, *" " by " title))))
+ (result))
+ (erldoc-dom-walk
+ table (lambda (d)
+ (when (eq (car-safe d) 'a)
+ (push (cons (funcall fix-title (erldoc-dom-get-attribute d 'title))
+ (erldoc-expand-url
+ (erldoc-dom-get-attribute d 'href)
+ url))
+ result))))
+ (nreverse result)))
+
+(defvar erldoc-user-guides nil)
+
+(defvar erldoc-missing-user-guides
+ '("compiler" "hipe" "kernel" "os_mon" "parsetools" "typer")
+ "List of standard Erlang applications with no user guides.")
+
+;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name
+;; '*_app.html'.
+(defvar erldoc-app-manuals '("crypto" "diameter" "erl_docgen"
+ "kernel" "observer" "os_mon"
+ "runtime_tools" "sasl" "snmp"
+ "ssl" "test_server"
+ ("ssh" . "SSH") ("stdlib" . "STDLIB")
+ ("hipe" . "HiPE") ("typer" . "TypEr"))
+ "List of applications that come with a manual.")
+
+(defun erldoc-user-guide-chapters (user-guide)
+ (pcase-let ((`(,name . ,url) user-guide))
+ (unless (member name erldoc-missing-user-guides)
+ (let ((chaps (erldoc-dom-get-elements-by-id
+ (erldoc-dom-get-element-by-id (erldoc-parse-html url) "leftnav")
+ "no")))
+ (or chaps (warn "erldoc-user-guide-chapters no chapters found for `%s'"
+ (cdr user-guide)))
+ (mapcar (lambda (li)
+ (cons (concat name "#" (erldoc-dom-get-attribute li 'title))
+ (erldoc-expand-url (erldoc-dom-get-attribute
+ (erldoc-dom-get-element li 'a) 'href)
+ url)))
+ chaps)))))
+
+(defun erldoc-user-guides-1 ()
+ (let ((url (erldoc-expand-url "applications.html" erldoc-man-index))
+ app-guides app-mans)
+ (erldoc-dom-walk
+ (erldoc-parse-html url)
+ (lambda (d)
+ (when (and (eq (car-safe d) 'a)
+ (not (string-match-p "\\`[0-9.]+\\'" (erldoc-dom-get-text d))))
+ (with-demoted-errors "erldoc-user-guides-1: %S"
+ (let ((name (erldoc-strip-string (erldoc-dom-get-text d)))
+ (index-page (erldoc-fix-path (erldoc-expand-url
+ (erldoc-dom-get-attribute d 'href) url))))
+ (push (cons name (if (member name erldoc-missing-user-guides)
+ index-page
+ (erldoc-expand-url "users_guide.html" index-page)))
+ app-guides)
+ ;; Collect application manuals.
+ (pcase (assoc name (mapcar (lambda (x) (if (consp x) x (cons x x)))
+ erldoc-app-manuals))
+ (`(,_ . ,manual)
+ (push (cons name
+ (erldoc-expand-url (format "%s_app.html" manual)
+ index-page))
+ app-mans))))))))
+ (list (nreverse app-guides)
+ (nreverse app-mans))))
+
+(defun erldoc-user-guides ()
+ (or erldoc-user-guides
+ (let ((file (concat erldoc-output-file "-topics")))
+ (unless (file-exists-p file)
+ (unless (file-directory-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (with-temp-buffer
+ (pcase-let ((`(,guides ,mans) (erldoc-user-guides-1)))
+ (pp (append (cl-mapcan #'erldoc-user-guide-chapters
+ (append (mapcar
+ (lambda (dir)
+ (cons dir (erldoc-expand-url
+ (concat dir "/users_guide.html")
+ erldoc-man-index)))
+ '("design_principles"
+ "efficiency_guide"
+ "embedded"
+ "getting_started"
+ "installation_guide"
+ "oam"
+ "programming_examples"
+ "reference_manual"
+ "system_architecture_intro"
+ "system_principles"
+ "tutorial"))
+ guides))
+ (mapcar (lambda (man)
+ (pcase-let ((`(,name . ,url) man))
+ (cons (concat name " (App)") url)))
+ mans)
+ (erldoc-parse-eeps-index))
+ (current-buffer)))
+ (write-region nil nil file nil nil nil 'ask)))
+ (setq erldoc-user-guides (with-temp-buffer (insert-file-contents file)
+ (read (current-buffer)))))))
+
+;;;###autoload
+(defun erldoc-browse-topic (topic)
+ (interactive
+ (list (completing-read "User guide: " (erldoc-user-guides) nil t)))
+ (browse-url (cdr (assoc topic (erldoc-user-guides)))))
+
+(provide 'erldoc)
+;;; erldoc.el ends here
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index bece95e6b8..f627145f9f 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -1015,17 +1015,24 @@ open(cast, {button,_}, Data) ->
...
]]></code>
<p>
- The fact that a postponed event is only retried after a state change
- translates into a requirement on the event and state space.
- If you have a choice between storing a state data item
- in the <c>State</c> or in the <c>Data</c>:
- if a change in the item value affects which events that
- are handled, then this item is to be part of the state.
- </p>
- <p>
- You want to avoid that you maybe much later decide
- to postpone an event in one state and by misfortune it is never retried,
- as the code only changes the <c>Data</c> but not the <c>State</c>.
+ Since a postponed event is only retried after a state change,
+ you have to think about where to keep a state data item.
+ You can keep it in the server <c>Data</c>
+ or in the <c>State</c> itself,
+ for example by having two more or less identical states
+ to keep a boolean value, or by using a complex state with
+ <seealso marker="#Callback Modes">callback mode</seealso>
+ <seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>.
+ If a change in the value changes the set of events that is handled,
+ then the value should be kept in the State.
+ Otherwise no postponed events will be retried
+ since only the server Data changes.
+ </p>
+ <p>
+ This is not important if you do not postpone events.
+ But if you later decide to start postponing some events,
+ then the design flaw of not having separate states
+ when they should be, might become a hard to find bug.
</p>
<section>
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-24 22:28:37 +0000