git.iko.soy/distributed-process
on master help sign in
Merge pull request #192 from tweag/fix/say-2

Revert "Named send is intra-node, so we can use the optimised routing / encoding"

commit337db67a8b4cfeadb39bb26d899e29133cc74737 authorDuncan Coutts <duncan@community.haskell.org> dateSat 30 May 2015, 10:12 (11 years ago) parentd87528cced6592
2 files changed+15−7
compare with master
unifiedsplit
src/Control/Distributed/Process/Internal/Primitives.hs+1−1 src/Control/Distributed/Process/Node.hs+14−6
src/Control/Distributed/Process/Internal/Primitives.hs+1−1
@@ -1130,7 +1130,7 @@ whereisRemoteAsync nid label =
11301130-- | Named send to a process in the local registry (asynchronous)
11311131nsend :: Serializable a => String -> a -> Process ()
11321132nsend label msg =
1133− sendCtrlMsg Nothing (NamedSend label (createUnencodedMessage msg))
1133+ sendCtrlMsg Nothing (NamedSend label (createMessage msg))
11341134
11351135-- | Named send to a process in the local registry (asynchronous).
11361136-- 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
157157 , RegisterReply(..)
158158 , WhereIsReply(..)
159159 , payloadToMessage
160+ , messageToPayload
160161 , createUnencodedMessage
161162 , runLocalProcess
162163 , firstNonReservedProcessId
163− , ImplicitReconnect(WithImplicitReconnect)
164+ , ImplicitReconnect(WithImplicitReconnect,NoImplicitReconnect)
164165 )
165166import Control.Distributed.Process.Management.Internal.Agent
166167 ( mxAgentController
@@ -188,6 +189,7 @@ import Control.Distributed.Process.Serializable (Serializable)
188189import Control.Distributed.Process.Internal.Messaging
189190 ( sendBinary
190191 , sendMessage
192+ , sendPayload
191193 , closeImplicitReconnections
192194 , impliesDeathOf
193195 )
@@ -692,8 +694,8 @@ nodeController = do
692694 ncEffectRegister from label atnode pid force
693695 NCMsg (ProcessIdentifier from) (WhereIs label) ->
694696 ncEffectWhereIs from label
695− NCMsg _ (NamedSend label msg') ->
696− ncEffectNamedSend label msg'
697+ NCMsg (ProcessIdentifier from) (NamedSend label msg') ->
698+ ncEffectNamedSend from label msg'
697699 NCMsg _ (UnreliableSend lpid msg') ->
698700 ncEffectLocalSend node (ProcessId (localNodeId node) lpid) msg'
699701 NCMsg _ (LocalSend to msg') ->
@@ -912,11 +914,17 @@ ncEffectWhereIs from label = do
912914 (WhereIsReply label mPid)
913915
914916-- [Unified: Table 14]
915−ncEffectNamedSend :: String -> Message -> NC ()
916−ncEffectNamedSend label msg = do
917+ncEffectNamedSend :: ProcessId -> String -> Message -> NC ()
918+ncEffectNamedSend from label msg = do
917919 mPid <- gets (^. registeredHereFor label)
920+ node <- ask
918921 -- 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)
920928
921929-- [Issue #DP-20]
922930ncEffectLocalSend :: LocalNode -> ProcessId -> Message -> NC ()