Index

Table of contents

threads / actors

sleep
timer:sleep(Millis)
get process id
Pid = self()
execute function in concurrent thread
hello() -> io:fwrite("hello\n").
main() -> spawn(fun hello/0).
spawn function in another module
spawn(mymodule, myfunction/1, [])
sending a message
Pid ! message
receiving a message
receive
	one -> io:format("one received \n");
	two -> io:format("two received \n");
	_   -> io:format("unknown received\n")
end
receiving a message, but wait until timeout
receive
	_   -> io:format("unknown received\n")
after TimeoutInMillis -> [expr]
end
simple example: counting down
accept() ->
	receive
		{0,_} -> complete;
		{N,T} -> write_val(N), T ! {N-1,self()}, accept()
	after
		100 -> timeout
	end.

main() ->
	Pid1 = spawn(fun accept/0),
	Pid2 = spawn(fun accept/0),
	Pid1 ! { 5, Pid2 }.
linking two processes
link(Pid)
link(spawn(Function))
Pid = spawn_link(Function)
don't die if linked process dies
process_flag(trap_exit, true)
kill a process
exit(Pid, kill);
monitor a process
{Pid, Ref} = spawn_monitor(Function)
unmonitor a process
erlang:demonitor(Ref)
auto restart process on crash
restart(Function) ->
	process_flag(trap_exit, true),
	Pid = spawn_link(?MODULE, Function, []),
	receive
		{'EXIT', Pid, normal} -> ok;      % not a crash
		{'EXIT', Pid, shutdown} -> ok;    % manual termination, not a crash
		{'EXIT', Pid, _} -> restarter()
	end.
creating a name for a process
register([name], Pid)
[name] ! [message]
getting the pid for a named process
Pid = whereis([name])
documentation
http://erlang.org/doc/reference_manual/processes.html
https://erldocs.com/maint/erts/erlang.html

OTP genserver

hello world implementation
-module(myserver).
-behaviour(gen_server).
-export([init/1, send_call/2, send_cast/2, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).

init(V) -> {ok,[]}.

write_val(V) ->
  if
    is_float(V) -> io:fwrite(float_to_list(V) ++ "\n");
    is_integer(V) -> io:fwrite(integer_to_list(V) ++ "\n");
    is_list(V) -> lists:foreach(fun write_val/1, V), io:fwrite("\n");
    is_atom(V) -> io:fwrite(V), io:fwrite("~n");
    is_tuple(V) -> write_val(tuple_to_list(V));
    is_function(V) -> io:fwrite("#function\n");
    true -> io:fwrite("????\n")
  end.

send_call(Pid, V) ->
  gen_server:call(Pid, V).

send_cast(Pid, V) ->
  gen_server:cast(Pid, V).

handle_info(Message, State) ->
  io:format("handle_info~n"),
  {noreply, [Message | State]}.

handle_cast(Message, State) ->
  io:format("handle_cast~n"),
  {noreply, [Message | State]}.

handle_call(terminate, _From, Cats) -> {stop, normal, ok, Cats};
handle_call(Message, _From, State) ->
  io:format("handle_call~n"),
  {reply, Message, [Message | State]}.

terminate(normal, State) ->
  io:fwrite("shutting down!~n"),
  write_val(State).
calling the server
-module(test).
-main(main/0).
-export([main/0]).

main() ->
  {ok, Pid} = gen_server:start_link(myserver, [], []),
  Pid ! info_demo,
  myserver:send_cast(Pid, 1),
  myserver:send_call(Pid, 2),
  gen_server:call(Pid, terminate).

documentation

https://erldocs.com/maint/stdlib/gen_server.html

Generic Finite State Machine v2

hello world implementation
-module(my_server).
-behaviour(gen_statem).
-define(NAME, my_server).
-export([start_link/1, init/1, callback_mode/0, mystate/3, event/1]).


start_link(StateData) -> gen_statem:start_link({local,?NAME}, ?MODULE, StateData, []).
init(StateData) -> io:fwrite("init!~n~n"), {ok, mystate, StateData}.
callback_mode() -> state_functions.
event(Data) -> gen_statem:cast(?NAME, Data).

mystate(EventType, EventContent, Data) ->
  io:fwrite("mystate:~n"),
  util:write_val([EventType, EventContent, Data]),
  { next_state, mystate, Data }.
calling the server
my_server:start_link([state]),
my_server:event(bla),
complete.
use Module:StateName/3 functions for callbacks
callback_mode() -> state_functions.
mystate(EventType, EventContent, Data) ->
  io:fwrite("mystate:~n"),
  util:write_val([EventType, EventContent, Data]),
  { next_state, mystate, Data }.
use Module:handle_event/4 functions for callbacks
callback_mode() -> handle_event_function.
handle_event(EventType, EventContent, State, StateData) ->
  io:fwrite("handle_event:~n"),
  util:write_val([EventType, EventContent, State, StateData]),
  { next_state ,mystate, StateData }.
call a state enter function the first time we transition into a new state
callback_mode() -> [ state_enter, state_functions ].

mystate(enter, EventContent, Data) ->
  util:write_val([state_enter]),
  { keep_state, Data };

mystate(EventType, EventContent, Data) ->
  io:fwrite("mystate:~n"),
  util:write_val([EventType, EventContent, Data]),
  { next_state, mystate, Data }.

documentation

https://erlang.org/doc/man/gen_statem.html
https://erldocs.com/maint/stdlib/gen_statem.html
https://erlang.org/doc/design_principles/statem.html

Generic Finite State Machine v1

hello world implementation
-module(myserver).
-behaviour(gen_fsm).
-export([run/0, init/1, stop/0, a/2, b/2, handle_event/3, event_for_state/1, event_for_handle_event/1]).


init(State) -> {ok, a, State}.
run() -> gen_fsm:start_link({local, my_id}, ?MODULE, [], []).
stop() -> gen_fsm:send_all_state_event(my_id, stop).
event_for_state(Data) -> gen_fsm:send_event(my_id, Data).
event_for_handle_event(Data) -> gen_fsm:send_all_state_event(my_id, Data).

a(Event, StateData) -> io:fwrite("state 'a'~n"), { next_state, b, [Event | StateData] }.
b(Event, StateData) -> io:fwrite("state 'b'~n"), { next_state, a, [Event | StateData] }.

handle_event(stop, CurrentState, StateData) ->
  io:fwrite("stop event received, dumping state data ~n"),
  util:write_val(StateData),
  { stop, normal, [] };
handle_event(Event, CurrentState, StateData) ->
  io:fwrite("all state event received in state: "), util:write_val(CurrentState),
  { next_state, CurrentState, [Event | StateData] }.
calling the server
N = myserver:run(),
myserver:event_for_state(1),
myserver:event_for_state(2),
myserver:event_for_state(3),
myserver:event_for_handle_event(4),
myserver:stop(),
defining the initial state
-export([init/1]).
init(StateData) -> {ok, myinitialstate, StateData}.
sending an asynchronous event to the current state
-export([myevent/1, currentstate/2]).
myevent(Data) -> gen_fsm:send_event(my_id, Data).
currentstate(Event, StateData) -> util:write_val(Event), { next_state, state_name, StateData }.
sending a synchronous event to the current state
-export([myevent/1, currentstate/3]).
myevent(Data) -> gen_fsm:sync_send_event(my_id, Data).
currentstate(Event, From, StateData) -> util:write_val(Event), { reply, "reply data", next_state_id, StateData }.
sending and handling an asynchronous event regardless of the current state
-export([myevent/1, handle_event/3]).
myevent(Data) -> gen_fsm:send_all_state_event(my_id, stop).
handle_event(stop, CurrentState, StateData) -> { stop, normal, [] };
handle_event(Event, CurrentState, StateData) ->
  io:fwrite("unexpected event: "), util:write_val(Event),
  { next_state, CurrentState, StateData }.
sending and handling a synchronous event regardless of the current state
-export([myevent/1, handle_sync_event/4]).
myevent(Data) -> gen_fsm:sync_send_all_state_event(my_id, Data).
handle_sync_event(stop, From, CurrentState, StateData) -> { stop, normal, "reply data", [] };
handle_sync_event(Event, From, CurrentState, StateData) ->
  io:fwrite("unexpected event: "), util:write_val(Event),
  { reply, "reply data", CurrentState, StateData}.
handling other events
-export([handle_info/3]).
handle_info(Event, StateName, StateData) ->
  io:fwrite("handle info~n"),
  util:write_val(Event).
example of a message that goes to handle_info
{ok, Pid} = myserver:run(),
Pid ! 1,

documentation

https://erldocs.com/maint/stdlib/gen_fsm.html
http://erlang.org/documentation/doc-6.1/lib/stdlib-2.1/doc/html/gen_fsm.html
http://www1.erlang.org/doc/design_principles/fsm.html