packages feed

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 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