What I understand is that -export() make it possible to expose some, but not all, functions in a module definition. Inside the module definition, all functions are available, however.
I have a module that looks like this
-module(supervisor_test).
-export([start_listening/0, stop_listening/0, send_to_listener/1]).
listener() ->
receive
{Pid, Ref, x} ->
Pid ! {Ref, o};
{Pid, Ref, o} ->
Pid ! {Ref, x}
end.
supervisor() ->
process_flag(trap_exit, true),
Pid = spawn_link(?MODULE, listener, []),
register(reg_listener, Pid),
receive
{'EXIT', Pid, normal} -> % received when listener() finishes executing
ok;
{'EXIT', Pid, shutdown} -> % received when stop_listening() is called
ok;
{'EXIT', Pid, _} ->
supervisor()
end.
start_listening() ->
spawn(?MODULE, supervisor, []).
stop_listening() ->
Pid = whereis(reg_listener),
exit(Pid, shutdown).
send_to_listener(Value) ->
Ref = make_ref(),
reg_listener ! {self(), Ref, Value},
receive
{Ref, Reply} -> Reply
after 5000 ->
timeout
end.
Whenever I compile and call supvervisor_test:start_listening(), I get the following error
=ERROR REPORT==== ... ===
Error in process ... with exit value:
{undef,[{supervisor_test,supervisor,[],[]}]}
It goes away if I export_all and expose everything.
I tried compiling
-module(test).
-export([f1/0]).
f1() ->
f2().
f2() ->
io:format("I am here!~n").
and calling test:f1() and it works fine.
In start_listener() you're calling the MFA version of spawn(). This will use apply() and the apply docs state: "The applied function must be exported from Module."
Related
I have the following code:
-module(a).
-compile(export_all).
say(2,0) ->
[1,2];
say(A,B) ->
say(A-1,B-1).
loop(0) ->
io:format("");
loop(Times) ->
L = spawn(a, say, [4,2]),
io:fwrite( "L is ~w ~n", [L] ),
loop(Times-1).
run() ->
loop(4).
I want to have the list [1,2] in L each time function 'say' completes. However, since the pid of the process is returned instead of the list from the function say due to use of spawn, I am getting the following output:
L is <0.113.0>
L is <0.114.0>
L is <0.115.0>
L is <0.116.0>
What I desire is
L is [1,2]
L is [1,2]
L is [1,2]
L is [1,2]
How can I achieve this?
To pass information between processes, you use ! to send a message to another process's mailbox, and you use a receive clause to extract a message from a process mailbox. Here is an example:
-module(a).
-compile(export_all).
%% Worker process:
say(From, 2, 0) ->
From ! {self(), [1,2]};
say(From, A, B) ->
say(From, A-1, B-1).
%% Main process:
loop(0) ->
ok;
loop(Times) ->
Pid = spawn(a, say, [self(), 4, 2]),
receive %%waits here for result before spawning another process--no concurrency
{Pid, Result} ->
io:fwrite( "L is ~w ~n", [Result] )
end,
loop(Times-1).
%% Test:
run() ->
loop(4).
In the shell:
7> c(a).
a.erl:2: Warning: export_all flag enabled - all functions will be exported
{ok,a}
8> a:run().
L is [1,2]
L is [1,2]
L is [1,2]
L is [1,2]
ok
9>
Or, you can spawn all the processes, then read the results as they come in:
-module(a).
-compile(export_all).
%% Worker process:
say(From, 2, 0) ->
From ! [1,2];
say(From, A, B) ->
say(From, A-1, B-1).
%% Main process:
loop(N) ->
loop(N, N).
loop(0, Times) ->
display_results(Times);
loop(N, Times) ->
spawn(a, say, [self(), 4, 2]),
loop(N-1, Times).
display_results(0) ->
ok;
display_results(Times) ->
receive
Result ->
io:format("L is ~w~n", [Result])
end,
display_results(Times-1).
%% Test:
run() ->
loop(4).
To ensure that you only receive messages from the processes that you spawned, you can do this:
-module(a).
-compile(export_all).
%% Worker process:
say(From, 2, 0) ->
From ! {self(), [1,2]};
say(From, A, B) ->
say(From, A-1, B-1).
%% Main process:
loop(Times) ->
loop(Times, _Pids=[]).
loop(0, Pids) ->
display_results(Pids);
loop(Times, Pids) ->
Pid = spawn(a, say, [self(), 4, 2]),
loop(Times-1, [Pid|Pids]).
display_results([]) ->
ok;
display_results([Pid|Pids]) ->
receive
{Pid, Result} ->
io:format("L is ~w~n", [Result])
end,
display_results(Pids).
%% Test:
run() ->
loop(4).
There are some risks when using a receive like that: if a worker process crashes before it sends the message to your main process, then your main process will be stuck indefinitely in the receive while waiting for a message to arrive from the crashed process. One solution: use a timeout in the receive. Another: use spawn_monitor().
You need to use messages (or signals) for that, as the code is running in a separate process.
I like to use spawn_monitor in that case:
1> {Pid, MonitorReference} = spawn_monitor(fun() -> timer:sleep(10000), exit({ok, [1,2]}) end),
1> receive {'DOWN', MonitorReference, process, Pid, {ok, Result}} -> Result end.
Keep in mind that you can receive for several messages at the same time or you can just receive them in order (leaving the out of order ones in the mailbox). So you can spawn several threads and wait for all of them to be finished, gathering the results:
work(Workload) ->
JobReference = make_ref(),
PidReferences = [spawn_monitor(fun() -> exit({JobReference, do_stuff(WorkSlice)}) end) || WorkSlice <- Workload],
[receive
{'DOWN', Reference, process, Pid, {JobReference, Result}} -> Result;
{'DOWN', Reference, process, Pid, Result} -> {error, Result}
end || {Pid, Reference} <- PidReferences].
I'm trying to access Redis using Rust with the following:
extern crate redis;
use redis::{Client, Commands, Connection, RedisResult};
fn main() {
let redis_client = Client::open("redis://127.0.0.1/").unwrap();
let redis_conn = redis_client.get_connection().unwrap();
let mut keys_to_get = vec![];
keys_to_get.push("random_key_1".to_string());
keys_to_get.push("random_key_2".to_string());
let redis_result: String = redis_conn.get(keys_to_get).unwrap();
}
When I run cargo run I get:
Running `target/debug/test_resdis`
thread '<main>' panicked at 'called `Result::unwrap()` on an `Err` value: An error was signalled by the server: wrong number of arguments for 'get' command', ../src/libcore/result.rs:746
note: Run with `RUST_BACKTRACE=1` for a backtrace.
error: Process didn't exit successfully: `target/debug/test_resdis` (exit code: 101)
Am I doing something wrong, or is it a bug?
Running your program against a netcat server shows the following requests made:
*3
$3
GET
$12
random_key_1
$12
random_key_2
The GET command should be an MGET.
I believe this to be a bug in the implementation:
impl<T: ToRedisArgs> ToRedisArgs for Vec<T> {
fn to_redis_args(&self) -> Vec<Vec<u8>> {
ToRedisArgs::make_arg_vec(self)
}
}
impl<'a, T: ToRedisArgs> ToRedisArgs for &'a [T] {
fn to_redis_args(&self) -> Vec<Vec<u8>> {
ToRedisArgs::make_arg_vec(*self)
}
fn is_single_arg(&self) -> bool {
ToRedisArgs::is_single_vec_arg(*self)
}
}
Under the hood, the library inspects the key type to know if it's multivalued or not, using ToRedisArgs::is_single_arg, which has a default implementation of true.
As you can see, a slice implements ToRedisArgs::is_single_arg, but a Vec does not. This also suggests a workaround: treat the vector like a slice:
redis_conn.get(&*keys_to_get)
This issue has now been filed with the library.
I modified the kitchen module from Learn you some Erlang using standard IO functions to see what gets printed out in the order of execution and I found something really strange. Basically I ran the following in the shell
3> Pid = spawn(kitchen, fridge2, [[baking_soda]]).
<0.41.0>
4> kitchen:store(Pid, water).
0
2
1
ok
ok
It seems to me the function store has a call to the function fridge2 before the receive clause in the store function right after 0 is printed out and then after 2 is printed the receive clause is executed and 1 is finally printed. The modified code is below. How is the fridge2 function called from store function? Is this because of parallel execution somehow? What does this line do {Pid, Msg} -> in the store function? Is it a function call? and why is ok printed?
-module(kitchen).
-compile(export_all).
start(FoodList) ->
spawn(?MODULE, fridge2, [FoodList]).
store(Pid, Food) ->
Pid ! {self(), {store, Food}},
io:format("~p~n", [0]),
receive
{Pid, Msg} ->
io:format("~p~n", [1]),
io:format("~p~n", [Msg]),
Msg
end.
take(Pid, Food) ->
Pid ! {self(), {take, Food}},
receive
{Pid, Msg} -> Msg
end.
store2(Pid, Food) ->
Pid ! {self(), {store, Food}},
receive
{Pid, Msg} -> Msg
after 3000 ->
timeout
end.
take2(Pid, Food) ->
Pid ! {self(), {take, Food}},
receive
{Pid, Msg} -> Msg
after 3000 ->
timeout
end.
fridge1() ->
receive
{From, {store, _Food}} ->
From ! {self(), ok},
fridge1();
{From, {take, _Food}} ->
%% uh....
From ! {self(), not_found},
fridge1();
terminate ->
ok
end.
fridge2(FoodList) ->
receive
{From, {store, Food}} ->
From ! {self(), ok},
io:format("~p~n", [2]),
fridge2([Food|FoodList]);
{From, {take, Food}} ->
case lists:member(Food, FoodList) of
true ->
io:format("~p~n", [3]),
From ! {self(), {ok, Food}},
fridge2(lists:delete(Food, FoodList));
false ->
io:format("~p~n", [4]),
From ! {self(), not_found},
fridge2(FoodList)
end;
terminate ->
ok
end.
similar to case statements, receive uses pattern matching to determine what clause to execute. {Pid, Msg} is a clause that will match any 2-tuple.
let's walk through you the execution of your code --
Pid = spawn(kitchen, fridge2, [[baking_soda]]).
this spawns a new process that executes the kitchen:fridge2/1 function. that function blocks until it receives a message that is either a 2-tuple of the form {From, {[store|take], Food}} or the atom 'terminate'.
kitchen:store(Pid, water).
meanwhile, you call the above function from the shell. It sends the message {self(), {store, Food}} to that new process, prints "0" and then waits to receive a message that is a 2-tuple.
the other process has now received a message that satisties its receive. It sends the message {self(), ok} back to the process who sent the message, prints "2", recursively calls itself and again waits to receive a message.
the shell process has now received a message and continues execution. it prints "1" and then prints the second element of the tuple it received ("ok"). finally it returns 'ok' to the shell.
the shell prints the result ("ok") and displays a prompt.
the second process is still waiting to receive a message.
I have been trying to get some basic dynamic code compilation working using the GHC API by following a tutorial found here.
This code:
import GHC
import GHC.Paths
import DynFlags
import Unsafe.Coerce
main :: IO ()
main =
defaultErrorHandler defaultDynFlags $ do
func <- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags dflags
target <- guessTarget "Test.hs" Nothing
addTarget target
r <- load LoadAllTargets
case r of
Failed -> error "Compilation failed"
Succeeded -> do
m <- findModule (mkModuleName "Test") Nothing
setContext [] [m]
value <- compileExpr ("Test.print")
do let value' = (unsafeCoerce value) :: String -> IO ()
return value'
func "Hello"
return ()
Should get the print function from another file called Test.hs, load it and run its print function.
I compile the code with ghc version 7.4.1 using the command:
ghc -package ghc --make Api.hs
But receive the following error:
Api.hs:8:25:
Couldn't match expected type `Severity' with actual type `Settings'
Expected type: LogAction
Actual type: Settings -> DynFlags
In the first argument of `defaultErrorHandler', namely
`defaultDynFlags'
In the expression: defaultErrorHandler defaultDynFlags
What am I doing wrong? I have checked the GHC API docs but am not well versed enough in this kind of thing to understand most of it.
The tutorial is out of date. In ghc-7.0.* and previous, the type of defaultErorHandler was
defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
and defaultDynFlags was just a value.
As of ghc-7.2.*, the type of defaultErrorHandler is
defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => LogAction -> m a -> m a
defaultDynFlags is a function
defaultDynFlags :: Settings -> DynFlags
and LogAction is a synonym
type LogAction = Severity -> SrcSpan -> PprStyle -> Message -> IO ()
In 7.6, it has changed again, we now have
defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => FatalMessager -> FlushOut -> m a -> m a
with
type FatalMessager = String -> IO ()
and FlushOut being a newtype wrapper around IO ().
I'm not very familiar with the GHC Api (a too fast-moving target for me), so I'm not sure how the working code should look like, but for the 7.2 and 7.4 series, the first argument to defaultErrorHandler should probably be defaultLogAction.
Also the type of setContext has changed, I don't know if what I have does what you want, but it compiles (with 7.4.2; but you also need the ghc-paths package in addition to ghc for the GHC.Paths module) - I haven't tried to run it, though.
import GHC
import GHC.Paths
import DynFlags
import Unsafe.Coerce
main :: IO ()
main =
defaultErrorHandler defaultLogAction $ do
func <- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags dflags
target <- guessTarget "Test.hs" Nothing
addTarget target
r <- load LoadAllTargets
case r of
Failed -> error "Compilation failed"
Succeeded -> do
m <- findModule (mkModuleName "Test") Nothing
setContext [IIModule m]
value <- compileExpr ("Test.print")
do let value' = (unsafeCoerce value) :: String -> IO ()
return value'
func "Hello"
return ()
Here is a complete example for dynamic loading, also hosted here:
DynLoad.hs
-----------------------------------------------------------------------------
-- | Example for loading Haskell source code dynamically using the GHC api
-- Useful links:
-- GHC api:
-- http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/GHC.html
-- Wiki:
-- http://www.haskell.org/haskellwiki/GHC/As_a_library
-----------------------------------------------------------------------------
module DynLoad where
import GHC
import GhcMonad (liftIO)
import GHC.Paths (libdir)
import Name (getOccString)
import Data.Dynamic (fromDyn)
-- | List all exports of this module
-- and evaluate a symbol from a module DynTest
main =
runGhc (Just libdir) $ do
putString ":::Display exports of modules:::"
modSums <- initSession ["DynLoad","DynTest"]
let thisModSum = head modSums
exports <- listExports thisModSum
mapM_ putString exports
putString ":::Evaluate a name from module DynTest:::"
importDecl_RdrName <- parseImportDecl "import DynTest as D"
setContext [IIDecl importDecl_RdrName]
dynVal <- dynCompileExpr "D.aString"
liftIO $ print $ (fromDyn dynVal "nope-nothing")
-- | Init interactive session and load modules
initSession modStrNames = do
dflags <- getSessionDynFlags
setSessionDynFlags $ dflags {
hscTarget = HscInterpreted
, ghcLink = LinkInMemory
}
targets <- mapM
(\modStrName -> do
putString modStrName
target <- guessTarget ("*"++modStrName++".hs") Nothing
return target
) modStrNames
setTargets targets
load LoadAllTargets
modSums <- mapM
(\modStrName -> do
putString modStrName
modSum <- getModSummary $ mkModuleName modStrName
return $ ms_mod modSum
) modStrNames
return modSums
-- | List exported names of this or a sibling module
listExports mod = do
maybeModInfo <- getModuleInfo mod
case maybeModInfo of
(Just modInfo) -> do
let expNames = modInfoExports modInfo
expStrNames = map getOccString expNames
return expStrNames
_ -> return []
-- | Util for printing
putString = liftIO . putStrLn
And here is an example file to load:
DynTest.hs
module DynTest where
aString = "Hello"
How to fork/clone a process in Erlang, as the fork in Unix?
I have searched a lot but just got nothing.
Maybe the usage looks like this:
case fork() of
{parent, Pid} ->
in_parent_process_now();
{child, Pid} ->
in_child_process_now();
{error, Msg} ->
report_fork_error(Msg)
end.
Any ideas?
EDIT:
In order to explain my point better, take the following C code as an example:
f();
fork();
g();
Here the return value of fork() is ignored, so the next steps of both the parent process and the child process are the same, which is to execute g().
Can I achieve this in Erlang?
(This question was also answered in the erlang-questions mailing list.)
Erlang does not have a 'fork' operation. It has a spawn operation however:
parent_process() ->
will_be_executed_by_parent_process(),
spawn(fun() -> will_be_executed_by_child_process() end),
will_also_be_executed_by_parent_process().
... where function names show in what context they will be executed. Note that any data passed to the child process will be copied to the new process' heap.
As you know, there is generic pattern to implement processes in erlang:
loop( State ) ->
receive
Message ->
NewState = process( Message, State ),
loop( NewState )
end.
In each quant of time process has a State. So if you want to "fork" some process from current - you have to pass specific message for it. Process have to recognize that message and spawn the new process with copy of its current state in spawned process.
I've created example, to illustrate text above:
-module( test ).
-export( [ fork/1, get_state/1, change_state/2 ] ).
-export( [ loop/1 ] ).
loop( State ) ->
receive
{ fork, Sender } ->
%%
%% if you want to link with child process
%% call spawn_link instead of spawn
%%
ClonePid = spawn( ?MODULE, loop, [ State ] ),
responseTo( Sender, ClonePid ),
loop( State );
{ get_state, Sender } ->
responseTo( Sender, { curr_state, State } ),
loop( State );
{ change_state, Data, Sender } ->
{ Response, NewState } = processData( Data, State ),
responseTo( Sender, Response ),
loop( NewState )
end.
fork( Pid ) ->
Ref = make_ref(),
Pid ! { fork, { Ref, self() } },
get_response( Ref ).
get_state( Pid ) ->
Ref = make_ref(),
Pid ! { get_state, { Ref, self() } },
get_response( Ref ).
change_state( Pid, Data ) ->
Ref = make_ref(),
Pid ! { change_state, Data, { Ref, self() } },
get_response( Ref ).
get_response( Ref ) ->
receive
{ Ref, Message } -> Message
end.
responseTo( { Ref, Pid }, Mes ) ->
Pid ! { Ref, Mes }.
processData( Data, State ) ->
%%
%% here comes logic of processing data
%% and changing process state
%%
NewState = Data,
Response = { { old_state, State }, { new_state, NewState } },
{ Response, NewState }.
Lets test it in erlang shell:
1> c(test).
{ok,test}
Creating parent process with initial state first_state
2> ParentPid = spawn( test, loop, [ first_state ] ).
<0.38.0>
3> test:get_state( ParentPid ).
{curr_state,first_state}
4>
Lets change state of parent process to second_state:
4> test:change_state( ParentPid, second_state ).
{{old_state,first_state},{new_state,second_state}}
Fork new process from parent process:
5> ChildPid = test:fork( ParentPid ).
<0.42.0>
Check state of forked process (it is the same as in parent process):
6> test:get_state( ChildPid ).
{curr_state,second_state}
There is no fork in Erlang. But you can use one among spawn/1, spawn/2, spawn/3, spawn/4 (see also spawn_link) that are BIFs of erlang see erlang module.
So, for example:
-module(mymodule).
-export([parent_fun/0]).
parent_fun() ->
io:format("this is the parent with pid: ~p~n", [self()]),
spawn(fun() -> child_fun() end),
io:format("still in parent process: ~p~n", [self()]).
child_fun() ->
io:format("this is child process with pid: ~p~n", [self()]).
Execute in erlang shell as:
mymodule:parent_fun().
Note that parent process and child process have different pids.
I strongly suggest you to read: http://learnyousomeerlang.com/the-hitchhikers-guide-to-concurrency