aivika-branches 0.1.3 → 0.2
raw patch · 20 files changed
+711/−433 lines, 20 filesdep ~aivikadep ~aivika-transformersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aivika, aivika-transformers
API changes (from Hackage documentation)
- Simulation.Aivika.Branch.Br: branchLevel :: BrIO Int
- Simulation.Aivika.Branch.Br: data BrIO a
- Simulation.Aivika.Branch.Br: instance Simulation.Aivika.Trans.Comp.MonadComp Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.Br: instance Simulation.Aivika.Trans.DES.MonadDES Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.Br: instance Simulation.Aivika.Trans.Internal.Event.EventIOQueueing Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.Br: runBr :: BrIO a -> IO a
- Simulation.Aivika.Branch.Event: instance Simulation.Aivika.Trans.Internal.Types.EventQueueing Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.Generator: instance Simulation.Aivika.Trans.Generator.MonadGenerator Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.DequeueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.FCFS
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.DequeueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.LCFS
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.EnqueueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.FCFS
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.EnqueueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.LCFS
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.QueueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.FCFS
- Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.QueueStrategy Simulation.Aivika.Branch.Internal.Br.BrIO Simulation.Aivika.Trans.QueueStrategy.LCFS
- Simulation.Aivika.Branch.Ref.Base: instance Simulation.Aivika.Trans.Ref.Base.MonadRef Simulation.Aivika.Branch.Internal.Br.BrIO
- Simulation.Aivika.Branch.Ref.Base: instance Simulation.Aivika.Trans.Ref.Base.MonadRef0 Simulation.Aivika.Branch.Internal.Br.BrIO
+ Simulation.Aivika.Branch.BR: branchLevel :: Monad m => BR m Int
+ Simulation.Aivika.Branch.BR: data BR m a
+ Simulation.Aivika.Branch.BR: instance Simulation.Aivika.Trans.Comp.MonadComp (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.BR: instance Simulation.Aivika.Trans.DES.MonadDES (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.BR: instance Simulation.Aivika.Trans.Internal.Event.EventIOQueueing (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.BR: runBR :: MonadIO m => BR m a -> m a
+ Simulation.Aivika.Branch.Event: instance Simulation.Aivika.Trans.Internal.Types.EventQueueing (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.Generator: instance Simulation.Aivika.Trans.Generator.MonadGenerator (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.DequeueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.FCFS
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.DequeueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.LCFS
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.EnqueueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.FCFS
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.EnqueueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.LCFS
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.QueueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.FCFS
+ Simulation.Aivika.Branch.QueueStrategy: instance Simulation.Aivika.Trans.QueueStrategy.QueueStrategy (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO) Simulation.Aivika.Trans.QueueStrategy.LCFS
+ Simulation.Aivika.Branch.Ref.Base.Lazy: instance Simulation.Aivika.Trans.Ref.Base.Lazy.MonadRef (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.Ref.Base.Lazy: instance Simulation.Aivika.Trans.Ref.Base.Lazy.MonadRef0 (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.Ref.Base.Strict: instance Simulation.Aivika.Trans.Ref.Base.Strict.MonadRef (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
+ Simulation.Aivika.Branch.Ref.Base.Strict: instance Simulation.Aivika.Trans.Ref.Base.Strict.MonadRef0 (Simulation.Aivika.Branch.Internal.BR.BR GHC.Types.IO)
- Simulation.Aivika.Branch.Event: branchEvent :: Event BrIO a -> Event BrIO a
+ Simulation.Aivika.Branch.Event: branchEvent :: Event (BR IO) a -> Event (BR IO) a
- Simulation.Aivika.Branch.Event: futureEvent :: Double -> Event BrIO a -> Event BrIO a
+ Simulation.Aivika.Branch.Event: futureEvent :: Double -> Event (BR IO) a -> Event (BR IO) a
- Simulation.Aivika.Branch.Event: futureEventWith :: EventProcessing -> Double -> Event BrIO a -> Event BrIO a
+ Simulation.Aivika.Branch.Event: futureEventWith :: EventProcessing -> Double -> Event (BR IO) a -> Event (BR IO) a
Files
- CHANGELOG.md +5/−1
- LICENSE +1/−1
- Simulation/Aivika/Branch.hs +3/−3
- Simulation/Aivika/Branch/BR.hs +44/−0
- Simulation/Aivika/Branch/Br.hs +0/−39
- Simulation/Aivika/Branch/Event.hs +31/−31
- Simulation/Aivika/Branch/Generator.hs +21/−11
- Simulation/Aivika/Branch/Internal/BR.hs +145/−0
- Simulation/Aivika/Branch/Internal/Br.hs +0/−138
- Simulation/Aivika/Branch/Internal/Ref.hs +4/−141
- Simulation/Aivika/Branch/Internal/Ref/Lazy.hs +154/−0
- Simulation/Aivika/Branch/Internal/Ref/Strict.hs +154/−0
- Simulation/Aivika/Branch/QueueStrategy.hs +12/−12
- Simulation/Aivika/Branch/Ref/Base.hs +7/−38
- Simulation/Aivika/Branch/Ref/Base/Lazy.hs +50/−0
- Simulation/Aivika/Branch/Ref/Base/Strict.hs +50/−0
- aivika-branches.cabal +22/−10
- tests/Furnace.hs +2/−2
- tests/InspectionAdjustmentStations.hs +2/−2
- tests/MachRep1.hs +4/−4
CHANGELOG.md view
@@ -1,9 +1,13 @@ +Version 0.2+-----++* Renaming Br to BR and making the latter a monad transformer.+ Version 0.1.3 ----- * Targeting on a new version of aivika-transformers.- Version 0.1.2 -----
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016 David Sorokin <david.sorokin@gmail.com>+Copyright (c) 2016-2017 David Sorokin <david.sorokin@gmail.com> All rights reserved.
Simulation/Aivika/Branch.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Branch--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental@@ -11,13 +11,13 @@ -- module Simulation.Aivika.Branch (-- * Modules- module Simulation.Aivika.Branch.Br,+ module Simulation.Aivika.Branch.BR, module Simulation.Aivika.Branch.Event, module Simulation.Aivika.Branch.Generator, module Simulation.Aivika.Branch.QueueStrategy, module Simulation.Aivika.Branch.Ref.Base) where -import Simulation.Aivika.Branch.Br+import Simulation.Aivika.Branch.BR import Simulation.Aivika.Branch.Event import Simulation.Aivika.Branch.Generator import Simulation.Aivika.Branch.QueueStrategy
+ Simulation/Aivika/Branch/BR.hs view
@@ -0,0 +1,44 @@++{-# LANGUAGE FlexibleInstances #-}++-- |+-- Module : Simulation.Aivika.Branch.Br+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- This module defines that 'BR' can be an instance of the 'MonadDES' and 'EventIOQueueing' type classes.+--+module Simulation.Aivika.Branch.BR+ (BR,+ runBR,+ branchLevel) where++import Simulation.Aivika.Trans.Comp+import Simulation.Aivika.Trans.DES+import Simulation.Aivika.Trans.Exception+import Simulation.Aivika.Trans.Generator+import Simulation.Aivika.Trans.Event+import Simulation.Aivika.Trans.Ref.Base+import Simulation.Aivika.Trans.QueueStrategy++import Simulation.Aivika.IO++import Simulation.Aivika.Branch.Internal.BR+import Simulation.Aivika.Branch.Event+import Simulation.Aivika.Branch.Generator+import Simulation.Aivika.Branch.Ref.Base.Lazy+import Simulation.Aivika.Branch.Ref.Base.Strict+import Simulation.Aivika.Branch.QueueStrategy++instance MonadDES (BR IO)++instance MonadComp (BR IO)++-- | An implementation of the 'EventIOQueueing' type class.+instance EventIOQueueing (BR IO) where++ enqueueEventIO = enqueueEvent+
− Simulation/Aivika/Branch/Br.hs
@@ -1,39 +0,0 @@---- |--- Module : Simulation.Aivika.Branch.Br--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>--- License : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability : experimental--- Tested with: GHC 7.10.3------ This module defines 'BrIO' as an instance of the 'MonadDES' and 'EventIOQueueing' type classes.----module Simulation.Aivika.Branch.Br- (BrIO,- runBr,- branchLevel) where--import Simulation.Aivika.Trans.Comp-import Simulation.Aivika.Trans.DES-import Simulation.Aivika.Trans.Exception-import Simulation.Aivika.Trans.Generator-import Simulation.Aivika.Trans.Event-import Simulation.Aivika.Trans.Ref.Base-import Simulation.Aivika.Trans.QueueStrategy--import Simulation.Aivika.Branch.Internal.Br-import Simulation.Aivika.Branch.Event-import Simulation.Aivika.Branch.Generator-import Simulation.Aivika.Branch.Ref.Base-import Simulation.Aivika.Branch.QueueStrategy--instance MonadDES BrIO--instance MonadComp BrIO---- | An implementation of the 'EventIOQueueing' type class.-instance EventIOQueueing BrIO where-- enqueueEventIO = enqueueEvent-
Simulation/Aivika/Branch/Event.hs view
@@ -1,15 +1,15 @@ -{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, FlexibleInstances #-} -- | -- Module : Simulation.Aivika.Branch.Event--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.10.3 ----- The module defines an event queue, where 'BrIO' is an instance of 'EventQueueing'.+-- The module defines an event queue, where 'BR' can be an instance of 'EventQueueing'. -- Also it defines basic functions for branching computations. -- module Simulation.Aivika.Branch.Event@@ -27,14 +27,14 @@ import Simulation.Aivika.Trans import Simulation.Aivika.Trans.Internal.Types -import Simulation.Aivika.Branch.Internal.Br+import Simulation.Aivika.Branch.Internal.BR -- | An implementation of the 'EventQueueing' type class.-instance EventQueueing BrIO where+instance EventQueueing (BR IO) where -- | The event queue type.- data EventQueue BrIO =- EventQueue { queuePQ :: IORef (PQ.PriorityQueue (Point BrIO -> BrIO ())),+ data EventQueue (BR IO) =+ EventQueue { queuePQ :: IORef (PQ.PriorityQueue (Point (BR IO) -> BR IO ())), -- ^ the underlying priority queue queueBusy :: IORef Bool, -- ^ whether the queue is currently processing events@@ -52,7 +52,7 @@ enqueueEvent t (Event m) = Event $ \p ->- Br $ \ps ->+ BR $ \ps -> let pq = queuePQ $ runEventQueue $ pointRun p in modifyIORef pq $ \x -> PQ.enqueue x t m @@ -63,15 +63,15 @@ eventQueueCount = Event $ \p ->- Br $ \ps ->+ BR $ \ps -> let pq = queuePQ $ runEventQueue $ pointRun p in fmap PQ.queueCount $ readIORef pq -- | Process the pending events.-processPendingEventsCore :: Bool -> Dynamics BrIO ()+processPendingEventsCore :: Bool -> Dynamics (BR IO) () processPendingEventsCore includingCurrentEvents = Dynamics r where r p =- Br $ \ps ->+ BR $ \ps -> do let q = runEventQueue $ pointRun p f = queueBusy q f' <- readIORef f@@ -97,17 +97,17 @@ t0 = spcStartTime sc dt = spcDT sc n2 = fromIntegral $ floor ((t2 - t0) / dt)- invokeBr ps $+ invokeBR ps $ c2 $ p { pointTime = t2, pointIteration = n2, pointPhase = -1 } call q p ps -- | Process the pending events synchronously, i.e. without past.-processPendingEvents :: Bool -> Dynamics BrIO ()+processPendingEvents :: Bool -> Dynamics (BR IO) () processPendingEvents includingCurrentEvents = Dynamics r where r p =- Br $ \ps ->+ BR $ \ps -> do let q = runEventQueue $ pointRun p t = queueTime q t' <- readIORef t@@ -115,28 +115,28 @@ then error $ "The current time is less than " ++ "the time in the queue: processPendingEvents"- else invokeBr ps $+ else invokeBR ps $ invokeDynamics p $ processPendingEventsCore includingCurrentEvents -- | A memoized value.-processEventsIncludingCurrent :: Dynamics BrIO ()+processEventsIncludingCurrent :: Dynamics (BR IO) () processEventsIncludingCurrent = processPendingEvents True -- | A memoized value.-processEventsIncludingEarlier :: Dynamics BrIO ()+processEventsIncludingEarlier :: Dynamics (BR IO) () processEventsIncludingEarlier = processPendingEvents False -- | A memoized value.-processEventsIncludingCurrentCore :: Dynamics BrIO ()+processEventsIncludingCurrentCore :: Dynamics (BR IO) () processEventsIncludingCurrentCore = processPendingEventsCore True -- | A memoized value.-processEventsIncludingEarlierCore :: Dynamics BrIO ()+processEventsIncludingEarlierCore :: Dynamics (BR IO) () processEventsIncludingEarlierCore = processPendingEventsCore True -- | Process the events.-processEvents :: EventProcessing -> Dynamics BrIO ()+processEvents :: EventProcessing -> Dynamics (BR IO) () processEvents CurrentEvents = processEventsIncludingCurrent processEvents EarlierEvents = processEventsIncludingEarlier processEvents CurrentEventsOrFromPast = processEventsIncludingCurrentCore@@ -150,13 +150,13 @@ -- The state of the current computation including its event queue and mutable references 'Ref' -- remain intact. In some sense we copy the state of the model to the derivative branch and then -- proceed with the derived simulation. The copying operation is relatively cheap.-branchEvent :: Event BrIO a -> Event BrIO a+branchEvent :: Event (BR IO) a -> Event (BR IO) a branchEvent (Event m) = Event $ \p ->- Br $ \ps->+ BR $ \ps-> do p2 <- clonePoint p- ps2 <- newBrParams ps- invokeBr ps2 (m p2)+ ps2 <- newBRParams ps+ invokeBR ps2 (m p2) -- | Branch a new computation and return its result at the desired time -- in the future leaving the current computation intact.@@ -168,18 +168,18 @@ -- The state of the current computation including its event queue and mutable references 'Ref' -- remain intact. In some sense we copy the state of the model to the derivative branch and then -- proceed with the derived simulation. The copying operation is relatively cheap.-futureEvent :: Double -> Event BrIO a -> Event BrIO a+futureEvent :: Double -> Event (BR IO) a -> Event (BR IO) a futureEvent = futureEventWith CurrentEvents -- | Like 'futureEvent' but allows specifying how the pending events must be processed.-futureEventWith :: EventProcessing -> Double -> Event BrIO a -> Event BrIO a+futureEventWith :: EventProcessing -> Double -> Event (BR IO) a -> Event (BR IO) a futureEventWith processing t (Event m) = Event $ \p ->- Br $ \ps ->+ BR $ \ps -> do when (t < pointTime p) $ error "The specified time is less than the current modeling time: futureEventWith" p2 <- clonePoint p- ps2 <- newBrParams ps+ ps2 <- newBRParams ps let sc = pointSpecs p t0 = spcStartTime sc t' = spcStopTime sc@@ -188,13 +188,13 @@ p' = p2 { pointTime = t, pointIteration = n, pointPhase = -1 }- invokeBr ps2 $+ invokeBR ps2 $ invokeDynamics p' $ processEvents processing- invokeBr ps2 (m p')+ invokeBR ps2 (m p') -- | Clone the time point.-clonePoint :: Point BrIO -> IO (Point BrIO)+clonePoint :: Point (BR IO) -> IO (Point (BR IO)) clonePoint p = do let r = pointRun p q = runEventQueue r
Simulation/Aivika/Branch/Generator.hs view
@@ -1,16 +1,16 @@ -{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies, FlexibleInstances #-} -- | -- Module : Simulation.Aivika.Branch.Generator--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.10.3 -- -- Here is defined a random number generator,--- where 'BrIO' is an instance of 'MonadGenerator'.+-- where 'BR' can be an instance of 'MonadGenerator'. -- module Simulation.Aivika.Branch.Generator () where @@ -23,15 +23,17 @@ import Simulation.Aivika.Trans import Simulation.Aivika.Trans.Generator.Primitive-import Simulation.Aivika.Branch.Internal.Br+import Simulation.Aivika.Branch.Internal.BR -instance MonadGenerator BrIO where+instance MonadGenerator (BR IO) where - data Generator BrIO =- Generator { generator01 :: BrIO Double,+ data Generator (BR IO) =+ Generator { generator01 :: BR IO Double, -- ^ the generator of uniform numbers from 0 to 1- generatorNormal01 :: BrIO Double+ generatorNormal01 :: BR IO Double, -- ^ the generator of normal numbers with mean 0 and variance 1+ generatorSequenceNo :: BR IO Int+ -- ^ the generator of sequence numbers } generateUniform = generateUniform01 . generator01@@ -60,6 +62,8 @@ generateDiscrete = generateDiscrete01 . generator01 + generateSequenceNo = generatorSequenceNo+ newGenerator tp = case tp of SimpleGenerator ->@@ -81,14 +85,20 @@ newRandomGenerator01 g01 = do gNormal01 <- newNormalGenerator01 g01+ gSeqNoRef <- liftIO $ newIORef 0+ let gSeqNo =+ do x <- liftIO $ readIORef gSeqNoRef+ liftIO $ modifyIORef' gSeqNoRef (+1)+ return x return Generator { generator01 = g01,- generatorNormal01 = gNormal01 }+ generatorNormal01 = gNormal01,+ generatorSequenceNo = gSeqNo } -- | Create a normal random number generator with mean 0 and variance 1 -- by the specified generator of uniform random numbers from 0 to 1.-newNormalGenerator01 :: BrIO Double+newNormalGenerator01 :: BR IO Double -- ^ the generator- -> BrIO (BrIO Double)+ -> BR IO (BR IO Double) newNormalGenerator01 g = do nextRef <- liftIO $ newIORef 0.0 flagRef <- liftIO $ newIORef False
+ Simulation/Aivika/Branch/Internal/BR.hs view
@@ -0,0 +1,145 @@++{-# LANGUAGE RecursiveDo #-}++-- |+-- Module : Simulation.Aivika.Branch.Internal.BR+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- This module defines a branching computation.+--+module Simulation.Aivika.Branch.Internal.BR+ (BRParams(..),+ BR(..),+ invokeBR,+ runBR,+ newBRParams,+ newRootBRParams,+ branchLevel) where++import Data.IORef+import Data.Maybe++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Fix+import Control.Exception (throw, catch, finally)++import Simulation.Aivika.Trans.Exception++-- | The branching computation.+newtype BR m a = BR { unBR :: BRParams -> m a+ -- ^ Unwrap the computation.+ }++-- | The parameters of the computation.+data BRParams =+ BRParams { brId :: !Int,+ -- ^ The branch identifier.+ brIdGenerator :: IORef Int,+ -- ^ The generator of identifiers.+ brLevel :: !Int,+ -- ^ The branch level.+ brParent :: Maybe BRParams,+ -- ^ The branch parent.+ brUniqueRef :: IORef ()+ -- ^ The unique reference to which+ -- the finalizers are attached to+ -- be garbage collected.+ }++instance Monad m => Monad (BR m) where++ {-# INLINE return #-}+ return = BR . const . return++ {-# INLINE (>>=) #-}+ (BR m) >>= k = BR $ \ps ->+ m ps >>= \a ->+ let m' = unBR (k a) in m' ps++instance Applicative m => Applicative (BR m) where++ {-# INLINE pure #-}+ pure = BR . const . pure++ {-# INLINE (<*>) #-}+ (BR f) <*> (BR m) = BR $ \ps -> f ps <*> m ps++instance Functor m => Functor (BR m) where++ {-# INLINE fmap #-}+ fmap f (BR m) = BR $ fmap f . m ++instance MonadIO m => MonadIO (BR m) where++ {-# INLINE liftIO #-}+ liftIO = BR . const . liftIO++instance MonadTrans BR where++ {-# INLINE lift #-}+ lift = BR . const++instance MonadFix m => MonadFix (BR m) where++ mfix f = + BR $ \ps ->+ do { rec { a <- invokeBR ps (f a) }; return a }++instance MonadException m => MonadException (BR m) where++ catchComp (BR m) h = BR $ \ps ->+ catchComp (m ps) (\e -> unBR (h e) ps)++ finallyComp (BR m1) (BR m2) = BR $ \ps ->+ finallyComp (m1 ps) (m2 ps)+ + throwComp e = BR $ \ps ->+ throwComp e++-- | Invoke the computation.+invokeBR :: BRParams -> BR m a -> m a+{-# INLINE invokeBR #-}+invokeBR ps (BR m) = m ps++-- | Run the branching computation.+runBR :: MonadIO m => BR m a -> m a+{-# INLINABLE runBR #-}+runBR m =+ do ps <- liftIO newRootBRParams+ unBR m ps++-- | Create a new child branch.+newBRParams :: BRParams -> IO BRParams+newBRParams ps =+ do id <- atomicModifyIORef (brIdGenerator ps) $ \a ->+ let b = a + 1 in b `seq` (b, b)+ let level = 1 + brLevel ps+ uniqueRef <- newIORef ()+ return BRParams { brId = id,+ brIdGenerator = brIdGenerator ps,+ brLevel = level `seq` level,+ brParent = Just ps,+ brUniqueRef = uniqueRef }++-- | Create a root branch.+newRootBRParams :: IO BRParams+newRootBRParams =+ do genId <- newIORef 0+ uniqueRef <- newIORef ()+ return BRParams { brId = 0,+ brIdGenerator = genId,+ brLevel = 0,+ brParent = Nothing,+ brUniqueRef = uniqueRef+ }++-- | Return the current branch level starting from 0.+branchLevel :: Monad m => BR m Int+{-# INLINABLE branchLevel #-}+branchLevel = BR $ \ps -> return (brLevel ps)
− Simulation/Aivika/Branch/Internal/Br.hs
@@ -1,138 +0,0 @@--{-# LANGUAGE RecursiveDo #-}---- |--- Module : Simulation.Aivika.Branch.Internal.Br--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>--- License : BSD3--- Maintainer : David Sorokin <david.sorokin@gmail.com>--- Stability : experimental--- Tested with: GHC 7.10.3------ This module defines a branching computation.----module Simulation.Aivika.Branch.Internal.Br- (BrParams(..),- BrIO(..),- invokeBr,- runBr,- newBrParams,- newRootBrParams,- branchLevel) where--import Data.IORef-import Data.Maybe--import Control.Applicative-import Control.Monad-import Control.Monad.Trans-import Control.Monad.Fix-import Control.Exception (throw, catch, finally)--import Simulation.Aivika.Trans.Exception---- | The branching computation.-newtype BrIO a = Br { unBr :: BrParams -> IO a- -- ^ Unwrap the computation.- }---- | The parameters of the computation.-data BrParams =- BrParams { brId :: !Int,- -- ^ The branch identifier.- brIdGenerator :: IORef Int,- -- ^ The generator of identifiers.- brLevel :: !Int,- -- ^ The branch level.- brParent :: Maybe BrParams,- -- ^ The branch parent.- brUniqueRef :: IORef ()- -- ^ The unique reference to which- -- the finalizers are attached to- -- be garbage collected.- }--instance Monad BrIO where-- {-# INLINE return #-}- return = Br . const . return-- {-# INLINE (>>=) #-}- (Br m) >>= k = Br $ \ps ->- m ps >>= \a ->- let m' = unBr (k a) in m' ps--instance Applicative BrIO where-- {-# INLINE pure #-}- pure = return-- {-# INLINE (<*>) #-}- (<*>) = ap--instance Functor BrIO where-- {-# INLINE fmap #-}- fmap f (Br m) = Br $ fmap f . m --instance MonadIO BrIO where-- {-# INLINE liftIO #-}- liftIO = Br . const . liftIO--instance MonadFix BrIO where-- mfix f = - Br $ \ps ->- do { rec { a <- invokeBr ps (f a) }; return a }--instance MonadException BrIO where-- catchComp (Br m) h = Br $ \ps ->- catch (m ps) (\e -> unBr (h e) ps)-- finallyComp (Br m1) (Br m2) = Br $ \ps ->- finally (m1 ps) (m2 ps)- - throwComp e = Br $ \ps ->- throw e---- | Invoke the computation.-invokeBr :: BrParams -> BrIO a -> IO a-{-# INLINE invokeBr #-}-invokeBr ps (Br m) = m ps---- | Run the branching computation.-runBr :: BrIO a -> IO a-runBr m =- do ps <- newRootBrParams- unBr m ps---- | Create a new child branch.-newBrParams :: BrParams -> IO BrParams-newBrParams ps =- do id <- atomicModifyIORef (brIdGenerator ps) $ \a ->- let b = a + 1 in b `seq` (b, b)- let level = 1 + brLevel ps- uniqueRef <- newIORef ()- return BrParams { brId = id,- brIdGenerator = brIdGenerator ps,- brLevel = level `seq` level,- brParent = Just ps,- brUniqueRef = uniqueRef }---- | Create a root branch.-newRootBrParams :: IO BrParams-newRootBrParams =- do genId <- newIORef 0- uniqueRef <- newIORef ()- return BrParams { brId = 0,- brIdGenerator = genId,- brLevel = 0,- brParent = Nothing,- brUniqueRef = uniqueRef- }---- | Return the current branch level starting from 0.-branchLevel :: BrIO Int-branchLevel = Br $ \ps -> return (brLevel ps)
Simulation/Aivika/Branch/Internal/Ref.hs view
@@ -3,152 +3,15 @@ -- | -- Module : Simulation.Aivika.Branch.Internal.Ref--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.10.3 ----- The implementation of mutable references.+-- The implementation of strict mutable references. -- module Simulation.Aivika.Branch.Internal.Ref- (Ref,- newEmptyRef,- newEmptyRef0,- newRef,- newRef0,- readRef,- writeRef,- modifyRef) where---- import Debug.Trace--import Data.IORef-import qualified Data.IntMap as M--import System.Mem.Weak--import Control.Monad-import Control.Monad.Trans--import Simulation.Aivika.Trans.Internal.Types--import Simulation.Aivika.Branch.Internal.Br---- | A reference map.-type RefMap a = IORef (M.IntMap (IORef a, Weak (IORef ())))---- | A mutable reference.-data Ref a = Ref { refMap :: RefMap a,- -- ^ the map of actual references- refWeakMap :: Weak (RefMap a)- -- ^ a weak reference to the map itself- }--instance Eq (Ref a) where- r1 == r2 = (refMap r1) == (refMap r2)---- | Create an empty reference.-newEmptyRef :: Simulation BrIO (Ref a)-newEmptyRef = Simulation $ const newEmptyRef0---- | Create an empty reference.-newEmptyRef0 :: BrIO (Ref a)-newEmptyRef0 =- Br $ \ps ->- do rm <- newIORef M.empty- wm <- mkWeakIORef rm $- -- trace ("fin newEmptyRef0: " ++ show (brId ps)) $- finalizeRef rm- return Ref { refMap = rm,- refWeakMap = wm }---- | Create a new reference.-newRef :: a -> Simulation BrIO (Ref a)-newRef = Simulation . const . newRef0---- | Create a new reference.-newRef0 :: a -> BrIO (Ref a)-newRef0 a =- Br $ \ps ->- do r <- invokeBr ps newEmptyRef0- ra <- newIORef a- let !i = brId ps- !wm = refWeakMap r- -- mkWeakIORef (brUniqueRef ps) (trace ("fin newIORef0: " ++ show i) $ finalizeCell wm i)- wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)- writeIORef (refMap r) $- M.insert i (ra, wa) M.empty- return r- --- | Read the value of a reference.-readRef :: Ref a -> Event BrIO a-readRef r =- Event $ \p ->- Br $ \ps ->- do m <- readIORef (refMap r)- let loop ps =- case M.lookup (brId ps) m of- Just (ra, wa) -> readIORef ra- Nothing ->- case brParent ps of- Just ps' -> loop ps'- Nothing -> error "Cannot find branch: readRef"- loop ps---- | Write a new value into the reference.-writeRef :: Ref a -> a -> Event BrIO ()-writeRef r a =- Event $ \p ->- Br $ \ps ->- do m <- readIORef (refMap r)- let !i = brId ps- case M.lookup i m of- Just (ra, wa) -> a `seq` writeIORef ra a- Nothing ->- do ra <- a `seq` newIORef a- let !wm = refWeakMap r- -- mkWeakIORef (brUniqueRef ps) (trace ("fin writeRef: " ++ show i) $ finalizeCell wm i)- wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)- atomicModifyIORef (refMap r) $ \m ->- let m' = M.insert i (ra, wa) m in (m', ())---- | Mutate the contents of the reference.-modifyRef :: Ref a -> (a -> a) -> Event BrIO ()-modifyRef r f =- Event $ \p ->- Br $ \ps ->- do m <- readIORef (refMap r)- let !i = brId ps- case M.lookup i m of- Just (ra, wa) ->- do a <- readIORef ra- let b = f a- b `seq` writeIORef ra b- Nothing ->- do a <- invokeBr ps $ invokeEvent p $ readRef r- invokeBr ps $ invokeEvent p $ writeRef r (f a)---- | Finalize the reference.-finalizeRef :: RefMap a -> IO ()-finalizeRef r =- do m <- readIORef r- forM_ (M.elems m) $ \(ra, wa) ->- finalize wa+ (module Simulation.Aivika.Branch.Internal.Ref.Strict) where --- | Finalize the reference cell by the specified branch identifier.-finalizeCell :: Weak (RefMap a) -> Int -> IO ()-finalizeCell wm i =- do rm <- deRefWeak wm- -- trace ("finalizeRef: " ++ show i) $ return ()- case rm of- Nothing ->- return ()- Just rm ->- do m <- readIORef rm- case M.lookup i m of- Just (ra, wa) ->- atomicModifyIORef rm $ \m ->- let m' = M.delete i m in (m', ())- Nothing ->- return ()+import Simulation.Aivika.Branch.Internal.Ref.Strict
+ Simulation/Aivika/Branch/Internal/Ref/Lazy.hs view
@@ -0,0 +1,154 @@++{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Simulation.Aivika.Branch.Internal.Ref.Lazy+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- The implementation of lazy mutable references.+--+module Simulation.Aivika.Branch.Internal.Ref.Lazy+ (Ref,+ newEmptyRef,+ newEmptyRef0,+ newRef,+ newRef0,+ readRef,+ writeRef,+ modifyRef) where++-- import Debug.Trace++import Data.IORef+import qualified Data.IntMap as M++import System.Mem.Weak++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Trans.Internal.Types++import Simulation.Aivika.Branch.Internal.BR++-- | A reference map.+type RefMap a = IORef (M.IntMap (IORef a, Weak (IORef ())))++-- | A lazy mutable reference.+data Ref a = Ref { refMap :: RefMap a,+ -- ^ the map of actual references+ refWeakMap :: Weak (RefMap a)+ -- ^ a weak reference to the map itself+ }++instance Eq (Ref a) where+ r1 == r2 = (refMap r1) == (refMap r2)++-- | Create an empty reference.+newEmptyRef :: Simulation (BR IO) (Ref a)+newEmptyRef = Simulation $ const newEmptyRef0++-- | Create an empty reference.+newEmptyRef0 :: BR IO (Ref a)+newEmptyRef0 =+ BR $ \ps ->+ do rm <- newIORef M.empty+ wm <- mkWeakIORef rm $+ -- trace ("fin newEmptyRef0: " ++ show (brId ps)) $+ finalizeRef rm+ return Ref { refMap = rm,+ refWeakMap = wm }++-- | Create a new reference.+newRef :: a -> Simulation (BR IO) (Ref a)+newRef = Simulation . const . newRef0++-- | Create a new reference.+newRef0 :: a -> BR IO (Ref a)+newRef0 a =+ BR $ \ps ->+ do r <- invokeBR ps newEmptyRef0+ ra <- newIORef a+ let !i = brId ps+ !wm = refWeakMap r+ -- mkWeakIORef (brUniqueRef ps) (trace ("fin newIORef0: " ++ show i) $ finalizeCell wm i)+ wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)+ writeIORef (refMap r) $+ M.insert i (ra, wa) M.empty+ return r+ +-- | Read the value of a reference.+readRef :: Ref a -> Event (BR IO) a+readRef r =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let loop ps =+ case M.lookup (brId ps) m of+ Just (ra, wa) -> readIORef ra+ Nothing ->+ case brParent ps of+ Just ps' -> loop ps'+ Nothing -> error "Cannot find branch: readRef"+ loop ps++-- | Write a new value into the reference.+writeRef :: Ref a -> a -> Event (BR IO) ()+writeRef r a =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let !i = brId ps+ case M.lookup i m of+ Just (ra, wa) -> writeIORef ra a+ Nothing ->+ do ra <- newIORef a+ let !wm = refWeakMap r+ -- mkWeakIORef (brUniqueRef ps) (trace ("fin writeRef: " ++ show i) $ finalizeCell wm i)+ wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)+ atomicModifyIORef (refMap r) $ \m ->+ let m' = M.insert i (ra, wa) m in (m', ())++-- | Mutate the contents of the reference.+modifyRef :: Ref a -> (a -> a) -> Event (BR IO) ()+modifyRef r f =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let !i = brId ps+ case M.lookup i m of+ Just (ra, wa) ->+ do a <- readIORef ra+ let b = f a+ writeIORef ra b+ Nothing ->+ do a <- invokeBR ps $ invokeEvent p $ readRef r+ invokeBR ps $ invokeEvent p $ writeRef r (f a)++-- | Finalize the reference.+finalizeRef :: RefMap a -> IO ()+finalizeRef r =+ do m <- readIORef r+ forM_ (M.elems m) $ \(ra, wa) ->+ finalize wa++-- | Finalize the reference cell by the specified branch identifier.+finalizeCell :: Weak (RefMap a) -> Int -> IO ()+finalizeCell wm i =+ do rm <- deRefWeak wm+ -- trace ("finalizeRef: " ++ show i) $ return ()+ case rm of+ Nothing ->+ return ()+ Just rm ->+ do m <- readIORef rm+ case M.lookup i m of+ Just (ra, wa) ->+ atomicModifyIORef rm $ \m ->+ let m' = M.delete i m in (m', ())+ Nothing ->+ return ()
+ Simulation/Aivika/Branch/Internal/Ref/Strict.hs view
@@ -0,0 +1,154 @@++{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Simulation.Aivika.Branch.Internal.Ref.Strict+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- The implementation of strict mutable references.+--+module Simulation.Aivika.Branch.Internal.Ref.Strict+ (Ref,+ newEmptyRef,+ newEmptyRef0,+ newRef,+ newRef0,+ readRef,+ writeRef,+ modifyRef) where++-- import Debug.Trace++import Data.IORef+import qualified Data.IntMap as M++import System.Mem.Weak++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Trans.Internal.Types++import Simulation.Aivika.Branch.Internal.BR++-- | A strict reference map.+type RefMap a = IORef (M.IntMap (IORef a, Weak (IORef ())))++-- | A mutable reference.+data Ref a = Ref { refMap :: RefMap a,+ -- ^ the map of actual references+ refWeakMap :: Weak (RefMap a)+ -- ^ a weak reference to the map itself+ }++instance Eq (Ref a) where+ r1 == r2 = (refMap r1) == (refMap r2)++-- | Create an empty reference.+newEmptyRef :: Simulation (BR IO) (Ref a)+newEmptyRef = Simulation $ const newEmptyRef0++-- | Create an empty reference.+newEmptyRef0 :: BR IO (Ref a)+newEmptyRef0 =+ BR $ \ps ->+ do rm <- newIORef M.empty+ wm <- mkWeakIORef rm $+ -- trace ("fin newEmptyRef0: " ++ show (brId ps)) $+ finalizeRef rm+ return Ref { refMap = rm,+ refWeakMap = wm }++-- | Create a new reference.+newRef :: a -> Simulation (BR IO) (Ref a)+newRef = Simulation . const . newRef0++-- | Create a new reference.+newRef0 :: a -> BR IO (Ref a)+newRef0 a =+ BR $ \ps ->+ do r <- invokeBR ps newEmptyRef0+ ra <- newIORef a+ let !i = brId ps+ !wm = refWeakMap r+ -- mkWeakIORef (brUniqueRef ps) (trace ("fin newIORef0: " ++ show i) $ finalizeCell wm i)+ wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)+ writeIORef (refMap r) $+ M.insert i (ra, wa) M.empty+ return r+ +-- | Read the value of a reference.+readRef :: Ref a -> Event (BR IO) a+readRef r =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let loop ps =+ case M.lookup (brId ps) m of+ Just (ra, wa) -> readIORef ra+ Nothing ->+ case brParent ps of+ Just ps' -> loop ps'+ Nothing -> error "Cannot find branch: readRef"+ loop ps++-- | Write a new value into the reference.+writeRef :: Ref a -> a -> Event (BR IO) ()+writeRef r a =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let !i = brId ps+ case M.lookup i m of+ Just (ra, wa) -> a `seq` writeIORef ra a+ Nothing ->+ do ra <- a `seq` newIORef a+ let !wm = refWeakMap r+ -- mkWeakIORef (brUniqueRef ps) (trace ("fin writeRef: " ++ show i) $ finalizeCell wm i)+ wa <- mkWeakIORef (brUniqueRef ps) (finalizeCell wm i)+ atomicModifyIORef (refMap r) $ \m ->+ let m' = M.insert i (ra, wa) m in (m', ())++-- | Mutate the contents of the reference.+modifyRef :: Ref a -> (a -> a) -> Event (BR IO) ()+modifyRef r f =+ Event $ \p ->+ BR $ \ps ->+ do m <- readIORef (refMap r)+ let !i = brId ps+ case M.lookup i m of+ Just (ra, wa) ->+ do a <- readIORef ra+ let b = f a+ b `seq` writeIORef ra b+ Nothing ->+ do a <- invokeBR ps $ invokeEvent p $ readRef r+ invokeBR ps $ invokeEvent p $ writeRef r (f a)++-- | Finalize the reference.+finalizeRef :: RefMap a -> IO ()+finalizeRef r =+ do m <- readIORef r+ forM_ (M.elems m) $ \(ra, wa) ->+ finalize wa++-- | Finalize the reference cell by the specified branch identifier.+finalizeCell :: Weak (RefMap a) -> Int -> IO ()+finalizeCell wm i =+ do rm <- deRefWeak wm+ -- trace ("finalizeRef: " ++ show i) $ return ()+ case rm of+ Nothing ->+ return ()+ Just rm ->+ do m <- readIORef rm+ case M.lookup i m of+ Just (ra, wa) ->+ atomicModifyIORef rm $ \m ->+ let m' = M.delete i m in (m', ())+ Nothing ->+ return ()
Simulation/Aivika/Branch/QueueStrategy.hs view
@@ -1,15 +1,15 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} -- | -- Module : Simulation.Aivika.Branch.QueueStrategy--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.10.3 ----- This module defines queue strategies 'FCFS' and 'LCFS' for the 'BrIO' computation.+-- This module defines queue strategies 'FCFS' and 'LCFS' for the 'BR' computation. -- module Simulation.Aivika.Branch.QueueStrategy () where @@ -18,21 +18,21 @@ import Simulation.Aivika.Trans import qualified Simulation.Aivika.Trans.DoubleLinkedList as LL -import Simulation.Aivika.Branch.Internal.Br+import Simulation.Aivika.Branch.Internal.BR import Simulation.Aivika.Branch.Ref.Base -- | An implementation of the 'FCFS' queue strategy.-instance QueueStrategy BrIO FCFS where+instance QueueStrategy (BR IO) FCFS where -- | A queue used by the 'FCFS' strategy.- newtype StrategyQueue BrIO FCFS a = FCFSQueue (LL.DoubleLinkedList BrIO a)+ newtype StrategyQueue (BR IO) FCFS a = FCFSQueue (LL.DoubleLinkedList (BR IO) a) newStrategyQueue s = fmap FCFSQueue LL.newList strategyQueueNull (FCFSQueue q) = LL.listNull q -- | An implementation of the 'FCFS' queue strategy.-instance DequeueStrategy BrIO FCFS where+instance DequeueStrategy (BR IO) FCFS where strategyDequeue (FCFSQueue q) = do i <- LL.listFirst q@@ -40,22 +40,22 @@ return i -- | An implementation of the 'FCFS' queue strategy.-instance EnqueueStrategy BrIO FCFS where+instance EnqueueStrategy (BR IO) FCFS where strategyEnqueue (FCFSQueue q) i = LL.listAddLast q i -- | An implementation of the 'LCFS' queue strategy.-instance QueueStrategy BrIO LCFS where+instance QueueStrategy (BR IO) LCFS where -- | A queue used by the 'LCFS' strategy.- newtype StrategyQueue BrIO LCFS a = LCFSQueue (LL.DoubleLinkedList BrIO a)+ newtype StrategyQueue (BR IO) LCFS a = LCFSQueue (LL.DoubleLinkedList (BR IO) a) newStrategyQueue s = fmap LCFSQueue LL.newList strategyQueueNull (LCFSQueue q) = LL.listNull q -- | An implementation of the 'LCFS' queue strategy.-instance DequeueStrategy BrIO LCFS where+instance DequeueStrategy (BR IO) LCFS where strategyDequeue (LCFSQueue q) = do i <- LL.listFirst q@@ -63,6 +63,6 @@ return i -- | An implementation of the 'LCFS' queue strategy.-instance EnqueueStrategy BrIO LCFS where+instance EnqueueStrategy (BR IO) LCFS where strategyEnqueue (LCFSQueue q) i = LL.listInsertFirst q i
Simulation/Aivika/Branch/Ref/Base.hs view
@@ -1,50 +1,19 @@ -{-# LANGUAGE TypeFamilies #-}- -- | -- Module : Simulation.Aivika.Branch.Ref.Base--- Copyright : Copyright (c) 2016, David Sorokin <david.sorokin@gmail.com>+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 7.10.3 ----- Here is an implementation of mutable references, where--- 'BrIO' is an instance of 'MonadRef' and 'MonadRef0'.+-- Here is an implementation of strict mutable references, where+-- 'BR' can be an instance of 'MonadRef' and 'MonadRef0'. ---module Simulation.Aivika.Branch.Ref.Base () where+module Simulation.Aivika.Branch.Ref.Base + (module Simulation.Aivika.Branch.Ref.Base.Strict) where -import Simulation.Aivika.Trans.Internal.Types-import Simulation.Aivika.Trans.Comp-import Simulation.Aivika.Trans.Simulation import Simulation.Aivika.Trans.Ref.Base -import Simulation.Aivika.Branch.Internal.Br-import qualified Simulation.Aivika.Branch.Internal.Ref as R---- | The implementation of mutable references.-instance MonadRef BrIO where-- -- | The mutable reference.- newtype Ref BrIO a = Ref { refValue :: R.Ref a }-- {-# INLINE newRef #-}- newRef = fmap Ref . R.newRef -- {-# INLINE readRef #-}- readRef (Ref r) = R.readRef r-- {-# INLINE writeRef #-}- writeRef (Ref r) = R.writeRef r-- {-# INLINE modifyRef #-}- modifyRef (Ref r) = R.modifyRef r-- {-# INLINE equalRef #-}- equalRef (Ref r1) (Ref r2) = (r1 == r2)---- | A subtype of mutable references that can be created under more weak conditions.-instance MonadRef0 BrIO where-- {-# INLINE newRef0 #-}- newRef0 = fmap Ref . R.newRef0+import Simulation.Aivika.Branch.Internal.BR+import Simulation.Aivika.Branch.Ref.Base.Strict
+ Simulation/Aivika/Branch/Ref/Base/Lazy.hs view
@@ -0,0 +1,50 @@++{-# LANGUAGE TypeFamilies, FlexibleInstances #-}++-- |+-- Module : Simulation.Aivika.Branch.Ref.Base.Lazy+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- Here is an implementation of lazy mutable references, where+-- 'BR' can be an instance of 'MonadRef' and 'MonadRef0'.+--+module Simulation.Aivika.Branch.Ref.Base.Lazy () where++import Simulation.Aivika.Trans.Internal.Types+import Simulation.Aivika.Trans.Comp+import Simulation.Aivika.Trans.Simulation+import Simulation.Aivika.Trans.Ref.Base.Lazy++import Simulation.Aivika.Branch.Internal.BR+import qualified Simulation.Aivika.Branch.Internal.Ref.Lazy as R++-- | The implementation of mutable references.+instance MonadRef (BR IO) where++ -- | The mutable reference.+ newtype Ref (BR IO) a = Ref { refValue :: R.Ref a }++ {-# INLINE newRef #-}+ newRef = fmap Ref . R.newRef ++ {-# INLINE readRef #-}+ readRef (Ref r) = R.readRef r++ {-# INLINE writeRef #-}+ writeRef (Ref r) = R.writeRef r++ {-# INLINE modifyRef #-}+ modifyRef (Ref r) = R.modifyRef r++ {-# INLINE equalRef #-}+ equalRef (Ref r1) (Ref r2) = (r1 == r2)++-- | A subtype of mutable references that can be created under more weak conditions.+instance MonadRef0 (BR IO) where++ {-# INLINE newRef0 #-}+ newRef0 = fmap Ref . R.newRef0
+ Simulation/Aivika/Branch/Ref/Base/Strict.hs view
@@ -0,0 +1,50 @@++{-# LANGUAGE TypeFamilies, FlexibleInstances #-}++-- |+-- Module : Simulation.Aivika.Branch.Ref.Base.Strict+-- Copyright : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>+-- License : BSD3+-- Maintainer : David Sorokin <david.sorokin@gmail.com>+-- Stability : experimental+-- Tested with: GHC 7.10.3+--+-- Here is an implementation of strict mutable references, where+-- 'BR' can be an instance of 'MonadRef' and 'MonadRef0'.+--+module Simulation.Aivika.Branch.Ref.Base.Strict () where++import Simulation.Aivika.Trans.Internal.Types+import Simulation.Aivika.Trans.Comp+import Simulation.Aivika.Trans.Simulation+import Simulation.Aivika.Trans.Ref.Base.Strict++import Simulation.Aivika.Branch.Internal.BR+import qualified Simulation.Aivika.Branch.Internal.Ref.Strict as R++-- | The implementation of mutable references.+instance MonadRef (BR IO) where++ -- | The mutable reference.+ newtype Ref (BR IO) a = Ref { refValue :: R.Ref a }++ {-# INLINE newRef #-}+ newRef = fmap Ref . R.newRef ++ {-# INLINE readRef #-}+ readRef (Ref r) = R.readRef r++ {-# INLINE writeRef #-}+ writeRef (Ref r) = R.writeRef r++ {-# INLINE modifyRef #-}+ modifyRef (Ref r) = R.modifyRef r++ {-# INLINE equalRef #-}+ equalRef (Ref r1) (Ref r2) = (r1 == r2)++-- | A subtype of mutable references that can be created under more weak conditions.+instance MonadRef0 (BR IO) where++ {-# INLINE newRef0 #-}+ newRef0 = fmap Ref . R.newRef0
aivika-branches.cabal view
@@ -1,22 +1,29 @@ name: aivika-branches-version: 0.1.3+version: 0.2 synopsis: Nested discrete event simulation module for the Aivika library description:- This package extends the aivika-transformers [1] library with facilities for creating branches to run- nested simulations within simulation. For example, it can be useful for financial modeling.+ This package extends the aivika-transformers [1] library and allows creating branches to run+ nested simulations within simulation. The branches are very cheap but still not free. .+ To run the simulation experiment by the Monte-Carlo method, you can use additional packages.+ They will allow you to save the simulation results in SQL database and then generate a report+ consisting of HTML pages with charts, histograms, links to CSV tables, summary statistics and so on.+ Please consult the AivikaSoft [2] website for more details.+ . \[1] <http://hackage.haskell.org/package/aivika-transformers> .+ \[2] <http://www.aivikasoft.com>+ . category: Simulation license: BSD3 license-file: LICENSE-copyright: (c) 2016. David Sorokin <david.sorokin@gmail.com>+copyright: (c) 2016-2017. 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+homepage: http://www.aivikasoft.com cabal-version: >= 1.6 build-type: Simple-tested-with: GHC == 7.10.3+tested-with: GHC == 8.0.1 extra-source-files: tests/MachRep1.hs tests/Furnace.hs@@ -26,24 +33,29 @@ library exposed-modules: Simulation.Aivika.Branch- Simulation.Aivika.Branch.Br+ Simulation.Aivika.Branch.BR Simulation.Aivika.Branch.Generator Simulation.Aivika.Branch.Event Simulation.Aivika.Branch.QueueStrategy Simulation.Aivika.Branch.Ref.Base+ Simulation.Aivika.Branch.Ref.Base.Lazy+ Simulation.Aivika.Branch.Ref.Base.Strict - other-modules: Simulation.Aivika.Branch.Internal.Br+ other-modules: Simulation.Aivika.Branch.Internal.BR Simulation.Aivika.Branch.Internal.Ref+ Simulation.Aivika.Branch.Internal.Ref.Lazy+ Simulation.Aivika.Branch.Internal.Ref.Strict build-depends: base >= 3 && < 6, mtl >= 2.1.1, containers >= 0.4.0.0, random >= 1.0.0.3,- aivika >= 4.5,- aivika-transformers >= 4.5+ aivika >= 5.1,+ aivika-transformers >= 5.1 extensions: TypeFamilies, MultiParamTypeClasses,+ FlexibleInstances, BangPatterns ghc-options: -O2
tests/Furnace.hs view
@@ -13,7 +13,7 @@ import Simulation.Aivika.Trans.Queue.Infinite import Simulation.Aivika.Branch -type DES = BrIO+type DES = BR IO -- | The simulation specs. specs = Specs { spcStartTime = 0.0,@@ -319,7 +319,7 @@ -- | The main program. main =- runBr $+ runBR $ printSimulationResultsInStopTime printResultSourceInEnglish model specs
tests/InspectionAdjustmentStations.hs view
@@ -23,7 +23,7 @@ import Simulation.Aivika.Trans.Queue.Infinite import Simulation.Aivika.Branch -type DES = BrIO+type DES = BR IO -- | The simulation specs. specs = Specs { spcStartTime = 0.0,@@ -162,7 +162,7 @@ modelSummary = fmap resultSummary model main =- runBr $+ runBR $ printSimulationResultsInStopTime printResultSourceInEnglish modelSummary specs
tests/MachRep1.hs view
@@ -30,7 +30,7 @@ spcMethod = RungeKutta4, spcGeneratorType = SimpleGenerator } -model :: Simulation BrIO (Results BrIO)+model :: Simulation (BR IO) (Results (BR IO)) model = do totalUpTime <- newRef 0.0 @@ -61,7 +61,7 @@ let dt' = (stoptime' - starttime') / fromIntegral maxLevel -- dt' <- liftParameter dt - let forecast :: Double -> Event BrIO Double+ let forecast :: Double -> Event (BR IO) Double forecast i = do level <- liftComp branchLevel if level <= maxLevel@@ -76,7 +76,7 @@ f <- runEventInStartTime $ forecast 0 - let upTimePropForecasted :: Event BrIO Double+ let upTimePropForecasted :: Event (BR IO) Double upTimePropForecasted = return f let upTimeProp =@@ -98,7 +98,7 @@ main :: IO () main =- runBr $+ runBR $ printSimulationResultsInStopTime printResultSourceInEnglish model specs