diff --git a/Simulation/Aivika/Distributed/Optimistic.hs b/Simulation/Aivika/Distributed/Optimistic.hs --- a/Simulation/Aivika/Distributed/Optimistic.hs +++ b/Simulation/Aivika/Distributed/Optimistic.hs @@ -13,7 +13,6 @@ module Simulation.Aivika.Distributed.Optimistic (-- * Modules module Simulation.Aivika.Distributed.Optimistic.DIO, - module Simulation.Aivika.Distributed.Optimistic.Event, module Simulation.Aivika.Distributed.Optimistic.Generator, module Simulation.Aivika.Distributed.Optimistic.Message, module Simulation.Aivika.Distributed.Optimistic.QueueStrategy, @@ -22,7 +21,6 @@ module Simulation.Aivika.Distributed.Optimistic.TimeServer) where import Simulation.Aivika.Distributed.Optimistic.DIO -import Simulation.Aivika.Distributed.Optimistic.Event import Simulation.Aivika.Distributed.Optimistic.Generator import Simulation.Aivika.Distributed.Optimistic.Message import Simulation.Aivika.Distributed.Optimistic.QueueStrategy diff --git a/Simulation/Aivika/Distributed/Optimistic/DIO.hs b/Simulation/Aivika/Distributed/Optimistic/DIO.hs --- a/Simulation/Aivika/Distributed/Optimistic/DIO.hs +++ b/Simulation/Aivika/Distributed/Optimistic/DIO.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Tested with: GHC 7.10.3 -- --- This module defines 'DIO' as an instance of the 'MonadDES' type class. +-- This module defines 'DIO' as an instance of the 'MonadDES' and 'EventIOQueueing' type classes. -- module Simulation.Aivika.Distributed.Optimistic.DIO (DIO, @@ -49,4 +49,3 @@ instance {-# OVERLAPPING #-} MonadIO (Process DIO) where liftIO = liftEvent . liftIO - diff --git a/Simulation/Aivika/Distributed/Optimistic/Event.hs b/Simulation/Aivika/Distributed/Optimistic/Event.hs deleted file mode 100644 --- a/Simulation/Aivika/Distributed/Optimistic/Event.hs +++ /dev/null @@ -1,34 +0,0 @@ - --- | --- Module : Simulation.Aivika.Distributed.Optimistic.Event --- Copyright : Copyright (c) 2015-2016, David Sorokin --- License : BSD3 --- Maintainer : David Sorokin --- Stability : experimental --- Tested with: GHC 7.10.3 --- --- This module defines additional functions for the 'Event' computation. --- -module Simulation.Aivika.Distributed.Optimistic.Event - (syncEvent, - syncEventInStopTime) where - -import Simulation.Aivika.Trans - -import Simulation.Aivika.Distributed.Optimistic.Internal.Event -import Simulation.Aivika.Distributed.Optimistic.DIO - --- | Synchronize the simulation in all nodes and call --- the specified computation in the stop time. --- --- The modeling time must be initial when calling this function. --- Also this call must be last in your part of the model. --- --- It is rather safe to call 'liftIO' within this function. -syncEventInStopTime :: Event DIO () -> Simulation DIO () -syncEventInStopTime h = - do t0 <- liftParameter stoptime - runEventInStartTime $ - syncEvent t0 h - runEventInStopTime $ - return () diff --git a/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs b/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs --- a/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs +++ b/Simulation/Aivika/Distributed/Optimistic/Internal/Event.hs @@ -14,8 +14,7 @@ module Simulation.Aivika.Distributed.Optimistic.Internal.Event (queueInputMessages, queueOutputMessages, - queueLog, - syncEvent) where + queueLog) where import Data.Maybe import Data.IORef @@ -645,20 +644,18 @@ invokeEvent p $ syncEvents processing --- | Synchronize the simulation in all nodes and call --- the specified computation at the given modeling time. --- --- It is rather safe to put 'liftIO' within this function. -syncEvent :: Double -> Event DIO () -> Event DIO () -syncEvent t h = - enqueueEvent t $ - Event $ \p -> - do ok <- invokeEvent p $ - runTimeWarp $ - syncLocalTime $ - return () - when ok $ - invokeEvent p h +-- | 'DIO' is an instance of 'EventIOQueueing'. +instance EventIOQueueing DIO where + + enqueueEventIO t h = + enqueueEvent t $ + Event $ \p -> + do ok <- invokeEvent p $ + runTimeWarp $ + syncLocalTime $ + return () + when ok $ + invokeEvent p h -- | Handle the 'Event' retry. handleEventRetry :: SimulationRetry -> Event DIO () diff --git a/aivika-distributed.cabal b/aivika-distributed.cabal --- a/aivika-distributed.cabal +++ b/aivika-distributed.cabal @@ -1,10 +1,12 @@ name: aivika-distributed -version: 0.1.3 -synopsis: Parallel distributed simulation library +version: 0.2 +synopsis: Parallel distributed discrete event simulation module for the Aivika library description: - This package extends the Aivika library with facilities for running parallel distributed simulations. + This package extends the aivika-transformers [1] package with facilities for running parallel distributed simulations. It uses an optimistic strategy known as the Time Warp method. . + \[1] + . category: Simulation license: BSD3 license-file: LICENSE @@ -29,7 +31,6 @@ exposed-modules: Simulation.Aivika.Distributed Simulation.Aivika.Distributed.Optimistic Simulation.Aivika.Distributed.Optimistic.DIO - Simulation.Aivika.Distributed.Optimistic.Event Simulation.Aivika.Distributed.Optimistic.Generator Simulation.Aivika.Distributed.Optimistic.QueueStrategy Simulation.Aivika.Distributed.Optimistic.Message @@ -54,14 +55,13 @@ mtl >= 2.1.1, stm >= 2.4.2, random >= 1.0.0.3, - bytestring >= 0.10.4.0, binary >= 0.6.4.0, time >= 1.5.0.1, containers >= 0.4.0.0, exceptions >= 0.8.0.2, distributed-process >= 0.6.1, - aivika >= 4.3.4, - aivika-transformers >= 4.3.4 + aivika >= 4.5, + aivika-transformers >= 4.5 extensions: MultiParamTypeClasses, FlexibleInstances, diff --git a/tests/MachRep1.hs b/tests/MachRep1.hs --- a/tests/MachRep1.hs +++ b/tests/MachRep1.hs @@ -70,9 +70,14 @@ runProcessInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + runEventInStopTime $ + return () + -- | The main model. masterModel :: Int -> Simulation DIO Double masterModel n = @@ -125,5 +130,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable diff --git a/tests/MachRep1Simple.hs b/tests/MachRep1Simple.hs --- a/tests/MachRep1Simple.hs +++ b/tests/MachRep1Simple.hs @@ -59,8 +59,10 @@ y <- liftDynamics time return $ x / (2 * y) - syncEventInStopTime $ - liftIO $ putStrLn "Test IO" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "Test IO" runEventInStopTime upTimeProp @@ -86,5 +88,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable diff --git a/tests/MachRep2.hs b/tests/MachRep2.hs --- a/tests/MachRep2.hs +++ b/tests/MachRep2.hs @@ -117,9 +117,14 @@ runEventInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + runEventInStopTime $ + return () + -- | The main model. masterModel :: Int -> Simulation DIO (Double, Double) masterModel count = @@ -219,5 +224,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable diff --git a/tests/MachRep2Distributed.hs b/tests/MachRep2Distributed.hs --- a/tests/MachRep2Distributed.hs +++ b/tests/MachRep2Distributed.hs @@ -136,8 +136,13 @@ runEventInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + + runEventInStopTime $ + return () -- | The main model. masterModel :: Int -> Simulation DIO (Double, Double) diff --git a/tests/MachRep2Reproducible.hs b/tests/MachRep2Reproducible.hs --- a/tests/MachRep2Reproducible.hs +++ b/tests/MachRep2Reproducible.hs @@ -133,9 +133,14 @@ runEventInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + runEventInStopTime $ + return () + -- | The main model. masterModel :: Int -> Simulation DIO (Double, Double) masterModel count = @@ -237,5 +242,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable diff --git a/tests/MachRep2Sync.hs b/tests/MachRep2Sync.hs --- a/tests/MachRep2Sync.hs +++ b/tests/MachRep2Sync.hs @@ -117,9 +117,14 @@ runEventInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + runEventInStopTime $ + return () + -- | The main model. masterModel :: Int -> Simulation DIO (Double, Double) masterModel count = @@ -171,8 +176,8 @@ enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId) runEventInStartTime $ - forM_ [100, 200.. 1000] $ \t -> - syncEvent t $ + enqueueEventIOWithTimes [100, 200..] $ + liftIO $ return () let upTimeProp = @@ -224,5 +229,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable diff --git a/tests/MachRep2SyncIO.hs b/tests/MachRep2SyncIO.hs --- a/tests/MachRep2SyncIO.hs +++ b/tests/MachRep2SyncIO.hs @@ -117,9 +117,14 @@ runEventInStartTime machine - syncEventInStopTime $ - liftIO $ putStrLn "The sub-model finished" + runEventInStartTime $ + enqueueEventIOWithStopTime $ + liftIO $ + putStrLn "The sub-model finished" + runEventInStopTime $ + return () + -- | The main model. masterModel :: Int -> Simulation DIO (Double, Double) masterModel count = @@ -171,11 +176,11 @@ enqueueMessage senderId (t + delta) (ReleaseRepairPersonResp inboxId) runEventInStartTime $ - forM_ [100, 200.. 1000] $ \t -> - syncEvent t $ - liftIO $ - putStrLn $ - "t = " ++ show t ++ ": synchronization" + enqueueEventIOWithTimes [100, 200..] $ + do t <- liftDynamics time + liftIO $ + putStrLn $ + "t = " ++ show t ++ ": synchronization" let upTimeProp = do x <- readRef totalUpTime @@ -226,5 +231,9 @@ main :: IO () main = do - backend <- initializeBackend "localhost" "8080" initRemoteTable + backend <- initializeBackend "localhost" "8080" rtable startMaster backend (master backend) + where + rtable :: DP.RemoteTable + -- rtable = __remoteTable initRemoteTable + rtable = initRemoteTable