aivika-gpss 0.6.2 → 0.7.1

raw patch · 11 files changed

+60/−26 lines, 11 filesdep ~aivikadep ~aivika-transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aivika, aivika-transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Simulation/Aivika/GPSS/Block/Generate.hs +2/−1
• Simulation/Aivika/GPSS/Block/Priority.hs +1/−1
• Simulation/Aivika/GPSS/Transact.hs +18/−6
• Simulation/Aivika/Trans/GPSS/AssemblySet.hs +1/−1
• Simulation/Aivika/Trans/GPSS/Block/Generate.hs +2/−1
• Simulation/Aivika/Trans/GPSS/Block/Priority.hs +1/−1
• Simulation/Aivika/Trans/GPSS/Queue.hs +1/−1
• Simulation/Aivika/Trans/GPSS/Queue.hs-boot +1/−1
• Simulation/Aivika/Trans/GPSS/Transact.hs +21/−6
• aivika-gpss.cabal +7/−7

@@ -1,4 +1,9 @@ +Version 0.7+-----++* More precise handling of transact priorities.+ Version 0.6.1 ----- 

@@ -45,7 +45,8 @@                         -> Int                         -- ^ the transact priority                         -> GeneratorBlock (Transact a)-streamGeneratorBlock s = streamGeneratorBlockM s . return+streamGeneratorBlock s priority = streamGeneratorBlockM s' (return priority)+  where s' = Cons $ processWithPriority priority >> runStream s  -- | Return a generator block by the specified stream using zero priority. streamGeneratorBlock0 :: Stream (Arrival a)

@@ -23,4 +23,4 @@                  -- ^ the priority                  -> Block (Transact a) (Transact a) priorityBlock priority =-  Block { blockProcess = \a -> return (assignTransactPriority a priority) }+  Block { blockProcess = \a -> assignTransactPriority a priority }

@@ -36,6 +36,8 @@ import Control.Exception  import Data.IORef+import Data.Functor+ import qualified Data.HashMap.Lazy as HM  import Simulation.Aivika@@ -73,6 +75,9 @@ instance Eq (Transact a) where   x == y = (transactProcessIdRef x) == (transactProcessIdRef y) +instance Functor Transact where+  fmap f t = t { transactValue = f (transactValue t) }+ -- | Create a new transact. newTransact :: Arrival a                -- ^ the arrival data@@ -133,7 +138,7 @@ takeTransact :: Transact a -> Process () takeTransact t =   Process $ \pid ->-  Cont $ \c ->+  Cont $ \c0 ->   Event $ \p ->   do pid0 <- readIORef (transactProcessIdRef t)      case pid0 of@@ -142,11 +147,17 @@          SimulationRetry          "The transact is acquired by another process: takeTransact"        Nothing   ->-         do writeIORef (transactProcessIdRef t) (Just pid)+         do let priority = transactPriority t+            writeIORef (transactProcessIdRef t) (Just pid)             n <- readIORef (transactPreemptionCountRef t)             if n == 0-              then invokeEvent p $ resumeCont c ()-              else do c <- invokeEvent p $+              then if priority == pointPriority p+                   then invokeEvent p $+                        resumeCont c0 ()+                   else invokeEvent p $+                        resumeCont (substituteContPriority c0 priority) ()+              else do let c = substituteContPriority c0 priority+                      c <- invokeEvent p $                            freezeContReentering c () $                            invokeCont c $                            invokeProcess pid $@@ -286,9 +297,10 @@      return t { transactValue = b }  -- | Assign the priority and return a new version of the same transact.-assignTransactPriority :: Transact a -> Int -> Transact a+assignTransactPriority :: Transact a -> Int -> Process (Transact a) assignTransactPriority t priority =-  t { transactPriority = priority }+  do processWithPriority priority+     return t { transactPriority = priority }  -- | Reactivate the transacts or transfer them to the specified computations. reactivateTransacts :: [(Transact a, Maybe (Process ()))] -> Event ()

@@ -50,7 +50,7 @@   {-# INLINABLE (==) #-}   x == y = (assemblySetAssemblingTransact x) == (assemblySetAssemblingTransact y) -instance Hashable (AssemblySet m) where+instance MonadDES m => Hashable (AssemblySet m) where   hashWithSalt salt x = hashWithSalt salt (assemblySetSequenceNo x)  -- | Create a new assembly set.

@@ -49,7 +49,8 @@                         -- ^ the transact priority                         -> GeneratorBlock m (Transact m a) {-# INLINABLE streamGeneratorBlock #-}-streamGeneratorBlock s = streamGeneratorBlockM s . return+streamGeneratorBlock s priority = streamGeneratorBlockM s' (return priority)+  where s' = Cons $ processWithPriority priority >> runStream s  -- | Return a generator block by the specified stream using zero priority. streamGeneratorBlock0 :: MonadDES m

@@ -25,4 +25,4 @@                  -> Block m (Transact m a) (Transact m a) {-# INLINABLE priorityBlock #-} priorityBlock priority =-  Block { blockProcess = \a -> return (assignTransactPriority a priority) }+  Block { blockProcess = \a -> assignTransactPriority a priority }

@@ -94,7 +94,7 @@ instance MonadDES m => Eq (Queue m) where   x == y = (queueContentRef x) == (queueContentRef y) -instance Hashable (Queue m) where+instance MonadDES m => Hashable (Queue m) where   hashWithSalt salt x = hashWithSalt salt (queueSequenceNo x)  -- | Create a new queue.

@@ -38,6 +38,6 @@              }  instance MonadDES m => Eq (Queue m)-instance Hashable (Queue m)+instance MonadDES m => Hashable (Queue m)  instance MonadDES m => Eq (QueueEntry m)

@@ -35,6 +35,8 @@ import Control.Monad.Trans import Control.Exception +import Data.Functor+ import qualified Data.HashMap.Lazy as HM  import Simulation.Aivika.Trans@@ -74,6 +76,11 @@   {-# INLINABLE (==) #-}   x == y = (transactProcessIdRef x) == (transactProcessIdRef y) +instance MonadDES m => Functor (Transact m) where++  {-# INLINABLE fmap #-}+  fmap f t = t { transactValue = f (transactValue t) }+ -- | Create a new transact. newTransact :: MonadDES m                => Arrival a@@ -139,7 +146,7 @@ {-# INLINABLE takeTransact #-} takeTransact t =   Process $ \pid ->-  Cont $ \c ->+  Cont $ \c0 ->   Event $ \p ->   do pid0 <- invokeEvent p $ readRef (transactProcessIdRef t)      case pid0 of@@ -148,11 +155,17 @@          SimulationRetry          "The transact is acquired by another process: takeTransact"        Nothing   ->-         do invokeEvent p $ writeRef (transactProcessIdRef t) (Just pid)+         do let priority = transactPriority t+            invokeEvent p $ writeRef (transactProcessIdRef t) (Just pid)             n <- invokeEvent p $ readRef (transactPreemptionCountRef t)             if n == 0-              then invokeEvent p $ resumeCont c ()-              else do c <- invokeEvent p $+              then if priority == pointPriority p+                   then invokeEvent p $+                        resumeCont c0 ()+                   else invokeEvent p $+                        resumeCont (substituteContPriority c0 priority) ()+              else do let c = substituteContPriority c0 priority+                      c <- invokeEvent p $                            freezeContReentering c () $                            invokeCont c $                            invokeProcess pid $@@ -300,9 +313,11 @@      return t { transactValue = b }  -- | Assign the priority and return a new version of the same transact.-assignTransactPriority :: Transact m a -> Int -> Transact m a+assignTransactPriority :: MonadDES m => Transact m a -> Int -> Process m (Transact m a)+{-# INLINABLE assignTransactPriority #-} assignTransactPriority t priority =-  t { transactPriority = priority }+  do processWithPriority priority+     return t { transactPriority = priority }  -- | Reactivate the transacts or transfer them to the specified computations. reactivateTransacts :: MonadDES m => [(Transact m a, Maybe (Process m ()))] -> Event m ()

@@ -1,5 +1,5 @@ name:            aivika-gpss-version:         0.6.2+version:         0.7.1 synopsis:        GPSS-like DSL for Aivika description:     This package allows defining simulation models in terms of a GPSS-like@@ -40,10 +40,10 @@ category:        Simulation license:         BSD3 license-file:    LICENSE-copyright:       (c) 2017-2018. David Sorokin <david.sorokin@gmail.com>+copyright:       (c) 2017-2023. David Sorokin <davsor@mail.ru> author:          David Sorokin-maintainer:      David Sorokin <david.sorokin@gmail.com>-homepage:        http://www.aivikasoft.com+maintainer:      David Sorokin <davsor@mail.ru>+homepage:        https://gitflic.ru/project/dsorokin/aivika-gpss cabal-version:   >= 1.10 build-type:      Simple tested-with:     GHC == 8.0.1@@ -145,8 +145,8 @@                      containers >= 0.4.0.0,                      hashable >= 1.2.0.0,                      unordered-containers >= 0.1.0.0,-                     aivika >= 5.9.1,-                     aivika-transformers >= 5.9.1+                     aivika >= 6.0.0,+                     aivika-transformers >= 6.0.0      other-extensions:   MultiParamTypeClasses,                         TypeFamilies,@@ -161,5 +161,5 @@ source-repository head      type:     git-    location: https://github.com/dsorokin/aivika-gpss+    location: https://gitflic.ru/project/dsorokin/aivika-gpss