git.iko.soy/distributed-process
on master help sign in
Bring terminology in line with the paper
5ab27fcEdsko de Vries
distributed-process/src/Control/Distributed/Process.hs+7−7
compare with master
unifiedsplit
@@ -15,8 +15,8 @@ module Control.Distributed.Process
15 , expect
15 , expect
16 , send
16 , send
17 , getSelfPid
17 , getSelfPid
18− , RemoteCallMetaData
18+ , RemoteTable
19− , initRemoteCallMetaData
19+ , initRemoteTable
20 -- * Matching messages
20 -- * Matching messages
21 , Match
21 , Match
22 , match
22 , match
@@ -95,8 +95,8 @@ import qualified Network.Transport as NT ( Transport
95import Data.Accessor ((^.), (^=), (^:))
95import Data.Accessor ((^.), (^=), (^:))
96import System.Random (randomIO)
96import System.Random (randomIO)
97import Control.Distributed.Process.Internal.NodeController (runNodeController)
97import Control.Distributed.Process.Internal.NodeController (runNodeController)
98−import Control.Distributed.Process.Internal ( RemoteCallMetaData
98+import Control.Distributed.Process.Internal ( RemoteTable
99− , initRemoteCallMetaData
99+ , initRemoteTable
100 , NodeId(..)
100 , NodeId(..)
101 , LocalProcessId(..)
101 , LocalProcessId(..)
102 , ProcessId(..)
102 , ProcessId(..)
@@ -296,8 +296,8 @@ expectTimeout timeout = receiveTimeout timeout [match return]
296--
296--
297-- Note that proper Cloud Haskell initialization and configuration is still
297-- Note that proper Cloud Haskell initialization and configuration is still
298-- to do.
298-- to do.
299−newLocalNode :: NT.Transport -> RemoteCallMetaData -> IO LocalNode
299+newLocalNode :: NT.Transport -> RemoteTable -> IO LocalNode
300−newLocalNode transport metaData = do
300+newLocalNode transport rtable = do
301 mEndPoint <- NT.newEndPoint transport
301 mEndPoint <- NT.newEndPoint transport
302 case mEndPoint of
302 case mEndPoint of
303 Left ex -> throwIO ex
303 Left ex -> throwIO ex
@@ -314,7 +314,7 @@ newLocalNode transport metaData = do
314 , localEndPoint = endPoint
314 , localEndPoint = endPoint
315 , localState = state
315 , localState = state
316 , localCtrlChan = ctrlChan
316 , localCtrlChan = ctrlChan
317− , localMetaData = metaData
317+ , remoteTable = rtable
318 }
318 }
319 void . forkIO $ runNodeController node
319 void . forkIO $ runNodeController node
320 void . forkIO $ handleIncomingMessages node
320 void . forkIO $ handleIncomingMessages node
distributed-process/src/Control/Distributed/Process/Closure.hs+15−15
@@ -25,17 +25,17 @@
25--
25--
26-- The call to 'remotable' will also generate a function
26-- The call to 'remotable' will also generate a function
27--
27--
28−-- > __remoteCallMetaData :: RemoteCallMetaData -> RemoteCallMetaData
28+-- > __remoteTable :: RemoteTable -> RemoteTable
29--
29--
30−-- which can be used to construct the 'RemoteCallMetaData' used to initialize
30+-- which can be used to construct the 'RemoteTable' used to initialize
31-- Cloud Haskell. You should have (at most) one call to 'remotable' per module,
31-- Cloud Haskell. You should have (at most) one call to 'remotable' per module,
32-- and compose all created functions when initializing Cloud Haskell:
32-- and compose all created functions when initializing Cloud Haskell:
33--
33--
34−-- > let metaData = M1.__remoteCallMetaData
34+-- > let rtable = M1.__remoteTable
35−-- > . M2.__remoteCallMetaData
35+-- > . M2.__remoteTable
36−-- > . ...
36+-- > . ...
37−-- > . Mn.__remoteCallMetaData
37+-- > . Mn.__remoteTable
38−-- > $ initRemoteCallMetaData
38+-- > $ initRemoteTable
39--
39--
40-- See Section 6, /Faking It/, of /Towards Haskell in the Cloud/ for more info.
40-- See Section 6, /Faking It/, of /Towards Haskell in the Cloud/ for more info.
41{-# LANGUAGE TemplateHaskell #-}
41{-# LANGUAGE TemplateHaskell #-}
@@ -80,9 +80,9 @@ import Language.Haskell.TH ( -- Q monad and operations
80 , sigD
80 , sigD
81 )
81 )
82import Control.Distributed.Process (Process)
82import Control.Distributed.Process (Process)
83−import Control.Distributed.Process.Internal ( RemoteCallMetaData
83+import Control.Distributed.Process.Internal ( RemoteTable
84 , LocalProcess(processNode)
84 , LocalProcess(processNode)
85− , LocalNode(localMetaData)
85+ , LocalNode(remoteTable)
86 )
86 )
87
87
88-- | A static value is one that is bound at top-level.
88-- | A static value is one that is bound at top-level.
@@ -103,8 +103,8 @@ data Closure a = Closure (Static (ByteString -> a)) ByteString
103remotable :: [Name] -> Q [Dec]
103remotable :: [Name] -> Q [Dec]
104remotable ns = do
104remotable ns = do
105 (closures, decoders, inserts) <- unzip3 <$> mapM process ns
105 (closures, decoders, inserts) <- unzip3 <$> mapM process ns
106− metaData <- createMetaData inserts
106+ rtable <- createMetaData inserts
107− return $ concat closures ++ concat decoders ++ metaData
107+ return $ concat closures ++ concat decoders ++ rtable
108
108
109-- | Deserialize a closure
109-- | Deserialize a closure
110unClosure :: Typeable a => Closure a -> Process a
110unClosure :: Typeable a => Closure a -> Process a
@@ -122,8 +122,8 @@ mkClosure = varE . closureName
122
122
123lookupStatic :: Typeable a => String -> Process a
123lookupStatic :: Typeable a => String -> Process a
124lookupStatic label = do
124lookupStatic label = do
125− metaData <- localMetaData . processNode <$> ask
125+ rtable <- remoteTable . processNode <$> ask
126− return $ fromDyn (metaData Map.! label) (throw typeError)
126+ return $ fromDyn (rtable Map.! label) (throw typeError)
127 where
127 where
128 typeError = userError "lookupStatic type error"
128 typeError = userError "lookupStatic type error"
129
129
@@ -138,8 +138,8 @@ instance Binary (Closure a) where
138-- | Generate the code to add the metadata to the CH runtime
138-- | Generate the code to add the metadata to the CH runtime
139createMetaData :: [Q Exp] -> Q [Dec]
139createMetaData :: [Q Exp] -> Q [Dec]
140createMetaData is =
140createMetaData is =
141− [d| __remoteCallMetaData :: RemoteCallMetaData -> RemoteCallMetaData ;
141+ [d| __remoteTable :: RemoteTable -> RemoteTable ;
142− __remoteCallMetaData = $(compose is)
142+ __remoteTable = $(compose is)
143 |]
143 |]
144
144
145-- | Generate the necessary definitions for one function
145-- | Generate the necessary definitions for one function
distributed-process/src/Control/Distributed/Process/Internal.hs+6−6
@@ -1,7 +1,7 @@
1module Control.Distributed.Process.Internal
1module Control.Distributed.Process.Internal
2 ( -- * Global CH state
2 ( -- * Global CH state
3− RemoteCallMetaData
3+ RemoteTable
4− , initRemoteCallMetaData
4+ , initRemoteTable
5 , -- * Node and process identifiers
5 , -- * Node and process identifiers
6 NodeId(..)
6 NodeId(..)
7 , LocalProcessId(..)
7 , LocalProcessId(..)
@@ -96,11 +96,11 @@ instance Show ProcessId where
96 show pid = show (processNodeId pid) ++ ":" ++ show (processLocalId pid)
96 show pid = show (processNodeId pid) ++ ":" ++ show (processLocalId pid)
97
97
98-- | Used to fake 'static' (see paper)
98-- | Used to fake 'static' (see paper)
99−type RemoteCallMetaData = Map String Dynamic
99+type RemoteTable = Map String Dynamic
100
100
101-- | Initial (empty) remote-call meta data
101-- | Initial (empty) remote-call meta data
102−initRemoteCallMetaData :: RemoteCallMetaData
102+initRemoteTable :: RemoteTable
103−initRemoteCallMetaData = Map.empty
103+initRemoteTable = Map.empty
104
104
105-- | Local nodes
105-- | Local nodes
106data LocalNode = LocalNode
106data LocalNode = LocalNode
@@ -109,7 +109,7 @@ data LocalNode = LocalNode
109 , localState :: MVar LocalNodeState
109 , localState :: MVar LocalNodeState
110 , localCtrlChan :: Chan NCMsg
110 , localCtrlChan :: Chan NCMsg
111 -- TODO: this should be part of the CH state, not the local endpoint state
111 -- TODO: this should be part of the CH state, not the local endpoint state
112− , localMetaData :: RemoteCallMetaData
112+ , remoteTable :: RemoteTable
113 }
113 }
114
114
115-- | Local node state
115-- | Local node state
distributed-process/tests/TestCH.hs+15−15
@@ -43,13 +43,13 @@ testPing transport = do
43
43
44 -- Server
44 -- Server
45 forkIO $ do
45 forkIO $ do
46− localNode <- newLocalNode transport initRemoteCallMetaData
46+ localNode <- newLocalNode transport initRemoteTable
47 addr <- forkProcess localNode ping
47 addr <- forkProcess localNode ping
48 putMVar serverAddr addr
48 putMVar serverAddr addr
49
49
50 -- Client
50 -- Client
51 forkIO $ do
51 forkIO $ do
52− localNode <- newLocalNode transport initRemoteCallMetaData
52+ localNode <- newLocalNode transport initRemoteTable
53 pingServer <- readMVar serverAddr
53 pingServer <- readMVar serverAddr
54
54
55 let numPings = 10000
55 let numPings = 10000
@@ -117,13 +117,13 @@ testMonitorUnreachable transport mOrL un = do
117 done <- newEmptyMVar
117 done <- newEmptyMVar
118
118
119 forkIO $ do
119 forkIO $ do
120− localNode <- newLocalNode transport initRemoteCallMetaData
120+ localNode <- newLocalNode transport initRemoteTable
121 addr <- forkProcess localNode . liftIO $ threadDelay 1000000
121 addr <- forkProcess localNode . liftIO $ threadDelay 1000000
122 closeLocalNode localNode
122 closeLocalNode localNode
123 putMVar deadProcess addr
123 putMVar deadProcess addr
124
124
125 forkIO $ do
125 forkIO $ do
126− localNode <- newLocalNode transport initRemoteCallMetaData
126+ localNode <- newLocalNode transport initRemoteTable
127 theirAddr <- readMVar deadProcess
127 theirAddr <- readMVar deadProcess
128 runProcess localNode $
128 runProcess localNode $
129 monitorTestProcess theirAddr mOrL un DiedDisconnect Nothing done
129 monitorTestProcess theirAddr mOrL un DiedDisconnect Nothing done
@@ -138,13 +138,13 @@ testMonitorNormalTermination transport mOrL un = do
138 done <- newEmptyMVar
138 done <- newEmptyMVar
139
139
140 forkIO $ do
140 forkIO $ do
141− localNode <- newLocalNode transport initRemoteCallMetaData
141+ localNode <- newLocalNode transport initRemoteTable
142 addr <- forkProcess localNode $
142 addr <- forkProcess localNode $
143 liftIO $ readMVar monitorSetup
143 liftIO $ readMVar monitorSetup
144 putMVar monitoredProcess addr
144 putMVar monitoredProcess addr
145
145
146 forkIO $ do
146 forkIO $ do
147− localNode <- newLocalNode transport initRemoteCallMetaData
147+ localNode <- newLocalNode transport initRemoteTable
148 theirAddr <- readMVar monitoredProcess
148 theirAddr <- readMVar monitoredProcess
149 runProcess localNode $
149 runProcess localNode $
150 monitorTestProcess theirAddr mOrL un DiedNormal (Just monitorSetup) done
150 monitorTestProcess theirAddr mOrL un DiedNormal (Just monitorSetup) done
@@ -161,14 +161,14 @@ testMonitorAbnormalTermination transport mOrL un = do
161 let err = userError "Abnormal termination"
161 let err = userError "Abnormal termination"
162
162
163 forkIO $ do
163 forkIO $ do
164− localNode <- newLocalNode transport initRemoteCallMetaData
164+ localNode <- newLocalNode transport initRemoteTable
165 addr <- forkProcess localNode . liftIO $ do
165 addr <- forkProcess localNode . liftIO $ do
166 readMVar monitorSetup
166 readMVar monitorSetup
167 throwIO err
167 throwIO err
168 putMVar monitoredProcess addr
168 putMVar monitoredProcess addr
169
169
170 forkIO $ do
170 forkIO $ do
171− localNode <- newLocalNode transport initRemoteCallMetaData
171+ localNode <- newLocalNode transport initRemoteTable
172 theirAddr <- readMVar monitoredProcess
172 theirAddr <- readMVar monitoredProcess
173 runProcess localNode $
173 runProcess localNode $
174 monitorTestProcess theirAddr mOrL un (DiedException (show err)) (Just monitorSetup) done
174 monitorTestProcess theirAddr mOrL un (DiedException (show err)) (Just monitorSetup) done
@@ -180,7 +180,7 @@ testMonitorLocalDeadProcess :: NT.Transport -> Bool -> Bool -> IO ()
180testMonitorLocalDeadProcess transport mOrL un = do
180testMonitorLocalDeadProcess transport mOrL un = do
181 processDead <- newEmptyMVar
181 processDead <- newEmptyMVar
182 processAddr <- newEmptyMVar
182 processAddr <- newEmptyMVar
183− localNode <- newLocalNode transport initRemoteCallMetaData
183+ localNode <- newLocalNode transport initRemoteTable
184 done <- newEmptyMVar
184 done <- newEmptyMVar
185
185
186 forkIO $ do
186 forkIO $ do
@@ -203,12 +203,12 @@ testMonitorRemoteDeadProcess transport mOrL un = do
203 done <- newEmptyMVar
203 done <- newEmptyMVar
204
204
205 forkIO $ do
205 forkIO $ do
206− localNode <- newLocalNode transport initRemoteCallMetaData
206+ localNode <- newLocalNode transport initRemoteTable
207 addr <- forkProcess localNode . liftIO $ putMVar processDead ()
207 addr <- forkProcess localNode . liftIO $ putMVar processDead ()
208 putMVar processAddr addr
208 putMVar processAddr addr
209
209
210 forkIO $ do
210 forkIO $ do
211− localNode <- newLocalNode transport initRemoteCallMetaData
211+ localNode <- newLocalNode transport initRemoteTable
212 theirAddr <- readMVar processAddr
212 theirAddr <- readMVar processAddr
213 readMVar processDead
213 readMVar processDead
214 runProcess localNode $ do
214 runProcess localNode $ do
@@ -224,14 +224,14 @@ testMonitorDisconnect transport mOrL un = do
224 done <- newEmptyMVar
224 done <- newEmptyMVar
225
225
226 forkIO $ do
226 forkIO $ do
227− localNode <- newLocalNode transport initRemoteCallMetaData
227+ localNode <- newLocalNode transport initRemoteTable
228 addr <- forkProcess localNode . liftIO $ threadDelay 1000000
228 addr <- forkProcess localNode . liftIO $ threadDelay 1000000
229 putMVar processAddr addr
229 putMVar processAddr addr
230 readMVar monitorSetup
230 readMVar monitorSetup
231 NT.closeEndPoint (localEndPoint localNode)
231 NT.closeEndPoint (localEndPoint localNode)
232
232
233 forkIO $ do
233 forkIO $ do
234− localNode <- newLocalNode transport initRemoteCallMetaData
234+ localNode <- newLocalNode transport initRemoteTable
235 theirAddr <- readMVar processAddr
235 theirAddr <- readMVar processAddr
236 runProcess localNode $ do
236 runProcess localNode $ do
237 monitorTestProcess theirAddr mOrL un DiedDisconnect (Just monitorSetup) done
237 monitorTestProcess theirAddr mOrL un DiedDisconnect (Just monitorSetup) done
@@ -272,13 +272,13 @@ testMath transport = do
272
272
273 -- Server
273 -- Server
274 forkIO $ do
274 forkIO $ do
275− localNode <- newLocalNode transport initRemoteCallMetaData
275+ localNode <- newLocalNode transport initRemoteTable
276 addr <- forkProcess localNode math
276 addr <- forkProcess localNode math
277 putMVar serverAddr addr
277 putMVar serverAddr addr
278
278
279 -- Client
279 -- Client
280 forkIO $ do
280 forkIO $ do
281− localNode <- newLocalNode transport initRemoteCallMetaData
281+ localNode <- newLocalNode transport initRemoteTable
282 mathServer <- readMVar serverAddr
282 mathServer <- readMVar serverAddr
283
283
284 runProcess localNode $ do
284 runProcess localNode $ do
distributed-process/tests/TestClosure.hs+4−4
@@ -20,7 +20,7 @@ sendInt = send
20
20
21$(remotable ['addInt, 'putInt, 'sendInt])
21$(remotable ['addInt, 'putInt, 'sendInt])
22
22
23−testSendPureClosure :: Transport -> RemoteCallMetaData -> IO ()
23+testSendPureClosure :: Transport -> RemoteTable -> IO ()
24testSendPureClosure transport metaData = do
24testSendPureClosure transport metaData = do
25 serverAddr <- newEmptyMVar
25 serverAddr <- newEmptyMVar
26 serverDone <- newEmptyMVar
26 serverDone <- newEmptyMVar
@@ -41,7 +41,7 @@ testSendPureClosure transport metaData = do
41
41
42 takeMVar serverDone
42 takeMVar serverDone
43
43
44−testSendIOClosure :: Transport -> RemoteCallMetaData -> IO ()
44+testSendIOClosure :: Transport -> RemoteTable -> IO ()
45testSendIOClosure transport metaData = do
45testSendIOClosure transport metaData = do
46 serverAddr <- newEmptyMVar
46 serverAddr <- newEmptyMVar
47 serverDone <- newEmptyMVar
47 serverDone <- newEmptyMVar
@@ -65,7 +65,7 @@ testSendIOClosure transport metaData = do
65
65
66 takeMVar serverDone
66 takeMVar serverDone
67
67
68−testSendProcClosure :: Transport -> RemoteCallMetaData -> IO ()
68+testSendProcClosure :: Transport -> RemoteTable -> IO ()
69testSendProcClosure transport metaData = do
69testSendProcClosure transport metaData = do
70 serverAddr <- newEmptyMVar
70 serverAddr <- newEmptyMVar
71 clientDone <- newEmptyMVar
71 clientDone <- newEmptyMVar
@@ -92,7 +92,7 @@ testSendProcClosure transport metaData = do
92main :: IO ()
92main :: IO ()
93main = do
93main = do
94 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
94 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
95− let metaData = __remoteCallMetaData initRemoteCallMetaData
95+ let metaData = __remoteTable initRemoteTable
96 runTests
96 runTests
97 [ ("SendPureClosure", testSendPureClosure transport metaData)
97 [ ("SendPureClosure", testSendPureClosure transport metaData)
98 , ("SendIOClosure", testSendIOClosure transport metaData)
98 , ("SendIOClosure", testSendIOClosure transport metaData)