aivika 4.3.3 → 4.3.4

raw patch · 13 files changed

+96/−32 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Simulation/Aivika/Event.hs +2/−0
• Simulation/Aivika/Internal/Cont.hs +9/−1
• Simulation/Aivika/Internal/Event.hs +7/−0
• Simulation/Aivika/Internal/Process.hs +7/−0
• Simulation/Aivika/Internal/Simulation.hs +14/−2
• Simulation/Aivika/Process.hs +2/−0
• Simulation/Aivika/Resource.hs +8/−5
• Simulation/Aivika/Resource/Base.hs +10/−6
• Simulation/Aivika/Resource/Preemption.hs +12/−7
• Simulation/Aivika/Resource/Preemption/Base.hs +14/−8
• Simulation/Aivika/Simulation.hs +2/−1
• aivika.cabal +2/−2

@@ -1,4 +1,11 @@ +Version 4.3.4+-----++* Yet more safe the resource preemption.++* Introducing exception SimulationRetry, which is needed for parallel distributed simulation.+ Version 4.3.3 ----- 

@@ -46,6 +46,8 @@         memoEventInTime,         -- * Disposable         DisposableEvent(..),+        -- * Retrying Computation+        retryEvent,         -- * Debugging         traceEvent) where 

@@ -790,7 +790,15 @@      if not f        then invokeEvent p $             enqueueEvent (pointTime p) $-            resumeCont c a+            Event $ \p ->+            do f <- invokeEvent p $+                    contPreemptionBegun $+                    contId $ contAux c+               if not f+                 then invokeEvent p $+                      resumeCont c a+                 else invokeEvent p $+                      sleepCont c a        else invokeEvent p $             sleepCont c a 

@@ -52,6 +52,8 @@         memoEventInTime,         -- * Disposable         DisposableEvent(..),+        -- * Retrying Computation+        retryEvent,         -- * Debugging         traceEvent) where @@ -409,6 +411,11 @@    mempty = DisposableEvent $ return ()   mappend (DisposableEvent x) (DisposableEvent y) = DisposableEvent $ x >> y++-- | Retry the current computation as possible, using the specified argument+-- as a 'SimulationRetry' exception message in case of failure.+retryEvent :: String -> Event a+retryEvent message = throwEvent $ SimulationRetry message  -- | Show the debug message with the current simulation time. traceEvent :: String -> Event a -> Event a

@@ -88,6 +88,8 @@         memoProcess,         -- * Never Ending Process         neverProcess,+        -- * Retrying Computation+        retryProcess,         -- * Debugging         traceProcess) where @@ -716,6 +718,11 @@   let signal = processCancelling pid   in handleSignal_ signal $ \_ ->      resumeCont c $ error "It must never be computed: neverProcess"++-- | Retry the current computation as possible, using the specified argument+-- as a 'SimulationRetry' exception message in case of failure.+retryProcess :: String -> Process a+retryProcess = liftEvent . retryEvent  -- | Show the debug message with the current simulation time. traceProcess :: String -> Process a -> Process a

@@ -32,7 +32,8 @@         memoSimulation,         -- * Exceptions         SimulationException(..),-        SimulationAbort(..)) where+        SimulationAbort(..),+        SimulationRetry(..)) where  import Control.Exception import Control.Monad@@ -197,11 +198,22 @@ instance Exception SimulationException  -- | An exception that signals of aborting the simulation.-data SimulationAbort = SimulationAbort+data SimulationAbort = SimulationAbort String                        -- ^ The exception to abort the simulation.                      deriving (Show, Typeable) +-- | An exception that signals that the current computation should be retried+-- as possible, which feature may be supported by the simulation engine or not.+data SimulationRetry = SimulationRetry String+                       -- ^ The exception to retry the computation.+                     deriving (Show, Typeable)+ instance Exception SimulationAbort where+  +  toException = toException . SimulationException+  fromException x = do { SimulationException a <- fromException x; cast a }++instance Exception SimulationRetry where      toException = toException . SimulationException   fromException x = do { SimulationException a <- fromException x; cast a }

@@ -83,6 +83,8 @@         memoProcess,         -- * Never Ending Process         neverProcess,+        -- * Retrying Computation+        retryProcess,         -- * Debugging         traceProcess) where 

@@ -214,12 +214,14 @@   do let r = pointRun p          t = pointTime p      when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResourceWithMaxCount."      case maxCount of        Just maxCount | count > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: newResourceWithMaxCount."        _ ->@@ -424,7 +426,8 @@      let a' = a + 1      case resourceMaxCount r of        Just maxCount | a' > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: releaseResource'."        _ ->@@ -509,7 +512,7 @@                     -- ^ the increment for the resource count                     -> Event () incResourceCount r n-  | n < 0     = error "The increment cannot be negative: incResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount"   | n == 0    = return ()   | otherwise =     do releaseResource' r@@ -524,7 +527,7 @@                     -- ^ the decrement for the resource count                     -> Process () decResourceCount r n-  | n < 0     = error "The decrement cannot be negative: decResourceCount"+  | n < 0     = throwProcess $ SimulationRetry "The decrement cannot be negative: decResourceCount"   | n == 0    = return ()   | otherwise =     do decResourceCount' r

@@ -167,7 +167,8 @@ newResource s count =   Simulation $ \r ->   do when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResource."      countRef <- newIORef count@@ -190,12 +191,14 @@ newResourceWithMaxCount s count maxCount =   Simulation $ \r ->   do when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResourceWithMaxCount."      case maxCount of        Just maxCount | count > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: newResourceWithMaxCount."        _ ->@@ -287,7 +290,8 @@      let a' = a + 1      case resourceMaxCount r of        Just maxCount | a' > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: releaseResourceWithinEvent."        _ ->@@ -358,7 +362,7 @@                     -- ^ the increment for the resource count                     -> Event () incResourceCount r n-  | n < 0     = error "The increment cannot be negative: incResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount"   | n == 0    = return ()   | otherwise =     do releaseResourceWithinEvent r@@ -373,7 +377,7 @@                     -- ^ the decrement for the resource count                     -> Process () decResourceCount r n-  | n < 0     = error "The decrement cannot be negative: decResourceCount"+  | n < 0     = throwProcess $ SimulationRetry "The decrement cannot be negative: decResourceCount"   | n == 0    = return ()   | otherwise =     do requestResource r

@@ -129,12 +129,14 @@   do let r = pointRun p          t = pointTime p      when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResourceWithMaxCount."      case maxCount of        Just maxCount | count > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: newResourceWithMaxCount."        _ ->@@ -314,7 +316,8 @@        then do invokeEvent p $ updateResourceUtilisationCount r (-1)                invokeEvent p $ releaseResource' r                invokeEvent p $ resumeCont c ()-       else error $+       else throwIO $+            SimulationRetry             "The resource was not acquired by this process: releaseResource"  -- | Release the resource increasing its count and resuming one of the@@ -328,7 +331,8 @@      let a' = a + 1      case resourceMaxCount r of        Just maxCount | a' > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: releaseResource'."        _ ->@@ -385,7 +389,8 @@   do let t = pointTime p      a <- readIORef (resourceCountRef r)      when (a == 0) $-       error $+       throwIO $+       SimulationRetry        "The resource exceeded and its count is zero: decResourceCount'"      f <- PQ.queueNull (resourceActingQueue r)      unless f $@@ -408,7 +413,7 @@                     -- ^ the increment for the resource count                     -> Event () incResourceCount r n-  | n < 0     = error "The increment cannot be negative: incResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount"   | n == 0    = return ()   | otherwise =     do releaseResource' r@@ -422,7 +427,7 @@                     -- ^ the decrement for the resource count                     -> Event () decResourceCount r n-  | n < 0     = error "The decrement cannot be negative: decResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The decrement cannot be negative: decResourceCount"   | n == 0    = return ()   | otherwise =     do decResourceCount' r

@@ -88,7 +88,8 @@ newResource count =   Simulation $ \r ->   do when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResource."      countRef <- newIORef count@@ -109,12 +110,14 @@ newResourceWithMaxCount count maxCount =   Simulation $ \r ->   do when (count < 0) $-       error $+       throwIO $+       SimulationRetry $        "The resource count cannot be negative: " ++        "newResourceWithMaxCount."      case maxCount of        Just maxCount | count > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: newResourceWithMaxCount."        _ ->@@ -191,7 +194,8 @@      if f        then do invokeEvent p $ releaseResource' r                invokeEvent p $ resumeCont c ()-       else error $+       else throwIO $+            SimulationRetry             "The resource was not acquired by this process: releaseResource"  -- | Release the resource increasing its count and resuming one of the@@ -205,7 +209,8 @@      let a' = a + 1      case resourceMaxCount r of        Just maxCount | a' > maxCount ->-         error $+         throwIO $+         SimulationRetry $          "The resource count cannot be greater than " ++          "its maximum value: releaseResource'."        _ ->@@ -256,7 +261,8 @@   Event $ \p ->   do a <- readIORef (resourceCountRef r)      when (a == 0) $-       error $+       throwIO $+       SimulationRetry        "The resource exceeded and its count is zero: decResourceCount'"      f <- PQ.queueNull (resourceActingQueue r)      unless f $@@ -278,7 +284,7 @@                     -- ^ the increment for the resource count                     -> Event () incResourceCount r n-  | n < 0     = error "The increment cannot be negative: incResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount"   | n == 0    = return ()   | otherwise =     do releaseResource' r@@ -292,7 +298,7 @@                     -- ^ the decrement for the resource count                     -> Event () decResourceCount r n-  | n < 0     = error "The decrement cannot be negative: decResourceCount"+  | n < 0     = throwEvent $ SimulationRetry "The decrement cannot be negative: decResourceCount"   | n == 0    = return ()   | otherwise =     do decResourceCount' r

@@ -25,6 +25,7 @@         memoSimulation,         -- * Exceptions         SimulationException(..),-        SimulationAbort(..)) where+        SimulationAbort(..),+        SimulationRetry(..)) where  import Simulation.Aivika.Internal.Simulation

@@ -1,5 +1,5 @@ name:            aivika-version:         4.3.3+version:         4.3.4 synopsis:        A multi-paradigm simulation library description:     Aivika is a multi-paradigm simulation library with a strong emphasis@@ -91,7 +91,7 @@ category:        Simulation license:         BSD3 license-file:    LICENSE-copyright:       (c) 2009-2015. David Sorokin <david.sorokin@gmail.com>+copyright:       (c) 2009-2016. David Sorokin <david.sorokin@gmail.com> author:          David Sorokin maintainer:      David Sorokin <david.sorokin@gmail.com> homepage:        http://www.aivikasoft.com/en/products/aivika.html