git.iko.soy/distributed-process
on master help sign in
Merge pull request #192 from tweag/fix/say-2
337db67Duncan Coutts
src/Control/Distributed/Process/Internal/Primitives.hs+1−1
compare with master
unifiedsplit
@@ -1130,7 +1130,7 @@ whereisRemoteAsync nid label =
1130-- | Named send to a process in the local registry (asynchronous)
1130-- | Named send to a process in the local registry (asynchronous)
1131nsend :: Serializable a => String -> a -> Process ()
1131nsend :: Serializable a => String -> a -> Process ()
1132nsend label msg =
1132nsend label msg =
1133− sendCtrlMsg Nothing (NamedSend label (createUnencodedMessage msg))
1133+ sendCtrlMsg Nothing (NamedSend label (createMessage msg))
1134
1134
1135-- | Named send to a process in the local registry (asynchronous).
1135-- | Named send to a process in the local registry (asynchronous).
1136-- This function makes /no/ attempt to serialize and (in the case when the
1136-- This function makes /no/ attempt to serialize and (in the case when the
src/Control/Distributed/Process/Node.hs+14−6
@@ -157,10 +157,11 @@ import Control.Distributed.Process.Internal.Types
157 , RegisterReply(..)
157 , RegisterReply(..)
158 , WhereIsReply(..)
158 , WhereIsReply(..)
159 , payloadToMessage
159 , payloadToMessage
160+ , messageToPayload
160 , createUnencodedMessage
161 , createUnencodedMessage
161 , runLocalProcess
162 , runLocalProcess
162 , firstNonReservedProcessId
163 , firstNonReservedProcessId
163− , ImplicitReconnect(WithImplicitReconnect)
164+ , ImplicitReconnect(WithImplicitReconnect,NoImplicitReconnect)
164 )
165 )
165import Control.Distributed.Process.Management.Internal.Agent
166import Control.Distributed.Process.Management.Internal.Agent
166 ( mxAgentController
167 ( mxAgentController
@@ -188,6 +189,7 @@ import Control.Distributed.Process.Serializable (Serializable)
188import Control.Distributed.Process.Internal.Messaging
189import Control.Distributed.Process.Internal.Messaging
189 ( sendBinary
190 ( sendBinary
190 , sendMessage
191 , sendMessage
192+ , sendPayload
191 , closeImplicitReconnections
193 , closeImplicitReconnections
192 , impliesDeathOf
194 , impliesDeathOf
193 )
195 )
@@ -692,8 +694,8 @@ nodeController = do
692 ncEffectRegister from label atnode pid force
694 ncEffectRegister from label atnode pid force
693 NCMsg (ProcessIdentifier from) (WhereIs label) ->
695 NCMsg (ProcessIdentifier from) (WhereIs label) ->
694 ncEffectWhereIs from label
696 ncEffectWhereIs from label
695− NCMsg _ (NamedSend label msg') ->
697+ NCMsg (ProcessIdentifier from) (NamedSend label msg') ->
696− ncEffectNamedSend label msg'
698+ ncEffectNamedSend from label msg'
697 NCMsg _ (UnreliableSend lpid msg') ->
699 NCMsg _ (UnreliableSend lpid msg') ->
698 ncEffectLocalSend node (ProcessId (localNodeId node) lpid) msg'
700 ncEffectLocalSend node (ProcessId (localNodeId node) lpid) msg'
699 NCMsg _ (LocalSend to msg') ->
701 NCMsg _ (LocalSend to msg') ->
@@ -912,11 +914,17 @@ ncEffectWhereIs from label = do
912 (WhereIsReply label mPid)
914 (WhereIsReply label mPid)
913
915
914-- [Unified: Table 14]
916-- [Unified: Table 14]
915−ncEffectNamedSend :: String -> Message -> NC ()
917+ncEffectNamedSend :: ProcessId -> String -> Message -> NC ()
916−ncEffectNamedSend label msg = do
918+ncEffectNamedSend from label msg = do
917 mPid <- gets (^. registeredHereFor label)
919 mPid <- gets (^. registeredHereFor label)
920+ node <- ask
918 -- If mPid is Nothing, we just ignore the named send (as per Table 14)
921 -- If mPid is Nothing, we just ignore the named send (as per Table 14)
919− forM_ mPid $ \pid -> postMessage pid msg
922+ forM_ mPid $ \pid ->
923+ liftIO $ sendPayload node
924+ (ProcessIdentifier from)
925+ (ProcessIdentifier pid)
926+ NoImplicitReconnect
927+ (messageToPayload msg)
920
928
921-- [Issue #DP-20]
929-- [Issue #DP-20]
922ncEffectLocalSend :: LocalNode -> ProcessId -> Message -> NC ()
930ncEffectLocalSend :: LocalNode -> ProcessId -> Message -> NC ()