diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,9 @@ +Version 0.2 +----- + +* Implemented lazy references. + Version 0.1.1 ----- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2016 David Sorokin +Copyright (c) 2016-2017 David Sorokin All rights reserved. diff --git a/Simulation/Aivika/Lattice.hs b/Simulation/Aivika/Lattice.hs --- a/Simulation/Aivika/Lattice.hs +++ b/Simulation/Aivika/Lattice.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Lattice --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Estimate.hs b/Simulation/Aivika/Lattice/Estimate.hs --- a/Simulation/Aivika/Lattice/Estimate.hs +++ b/Simulation/Aivika/Lattice/Estimate.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Estimate --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Event.hs b/Simulation/Aivika/Lattice/Event.hs --- a/Simulation/Aivika/Lattice/Event.hs +++ b/Simulation/Aivika/Lattice/Event.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Event --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Generator.hs b/Simulation/Aivika/Lattice/Generator.hs --- a/Simulation/Aivika/Lattice/Generator.hs +++ b/Simulation/Aivika/Lattice/Generator.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Generator --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -30,8 +30,10 @@ data Generator LIO = GeneratorLIO { generator01 :: LIO Double, -- ^ the generator of uniform numbers from 0 to 1 - generatorNormal01 :: LIO Double + generatorNormal01 :: LIO Double, -- ^ the generator of normal numbers with mean 0 and variance 1 + generatorSequenceNo :: LIO 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,8 +85,14 @@ newRandomGenerator01 g01 = do gNormal01 <- newNormalGenerator01 g01 + gSeqNoRef <- liftIO $ newIORef 0 + let gSeqNo = + do x <- liftIO $ readIORef gSeqNoRef + liftIO $ modifyIORef' gSeqNoRef (+1) + return x return GeneratorLIO { 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. diff --git a/Simulation/Aivika/Lattice/Internal/Estimate.hs b/Simulation/Aivika/Lattice/Internal/Estimate.hs --- a/Simulation/Aivika/Lattice/Internal/Estimate.hs +++ b/Simulation/Aivika/Lattice/Internal/Estimate.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Internal.Estimate --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Internal/Event.hs b/Simulation/Aivika/Lattice/Internal/Event.hs --- a/Simulation/Aivika/Lattice/Internal/Event.hs +++ b/Simulation/Aivika/Lattice/Internal/Event.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Internal.Event --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -13,7 +13,8 @@ -- Also it defines basic functions for running nested computations within lattice nodes. -- module Simulation.Aivika.Lattice.Internal.Event - (estimateRef) where + (estimateStrictRef, + estimateLazyRef) where import Data.IORef @@ -27,7 +28,8 @@ import Simulation.Aivika.Lattice.Internal.LIO import Simulation.Aivika.Lattice.Internal.Estimate -import qualified Simulation.Aivika.Lattice.Internal.Ref as R +import qualified Simulation.Aivika.Lattice.Internal.Ref.Strict as R +import qualified Simulation.Aivika.Lattice.Internal.Ref.Lazy as LazyR -- | An implementation of the 'EventQueueing' type class. instance EventQueueing LIO where @@ -195,8 +197,8 @@ processPendingEventsUnsafe True -- | Estimate the specified reference. -estimateRef :: R.Ref a -> Estimate LIO a -estimateRef r = +estimateStrictRef :: R.Ref a -> Estimate LIO a +estimateStrictRef r = Estimate $ \p -> LIO $ \ps -> do invokeLIO ps $ @@ -204,3 +206,14 @@ initEventQueue invokeLIO ps $ R.readRef0 r + +-- | Estimate the specified reference. +estimateLazyRef :: LazyR.Ref a -> Estimate LIO a +estimateLazyRef r = + Estimate $ \p -> + LIO $ \ps -> + do invokeLIO ps $ + invokeEvent p + initEventQueue + invokeLIO ps $ + LazyR.readRef0 r diff --git a/Simulation/Aivika/Lattice/Internal/LIO.hs b/Simulation/Aivika/Lattice/Internal/LIO.hs --- a/Simulation/Aivika/Lattice/Internal/LIO.hs +++ b/Simulation/Aivika/Lattice/Internal/LIO.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.Internal.LIO --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Internal/Ref.hs b/Simulation/Aivika/Lattice/Internal/Ref.hs --- a/Simulation/Aivika/Lattice/Internal/Ref.hs +++ b/Simulation/Aivika/Lattice/Internal/Ref.hs @@ -3,166 +3,15 @@ -- | -- Module : Simulation.Aivika.Lattice.Internal.Ref --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental -- Tested with: GHC 7.10.3 -- --- The implementation of mutable references. +-- The implementation of strict mutable references. -- module Simulation.Aivika.Lattice.Internal.Ref - (Ref, - newEmptyRef, - newEmptyRef0, - newRef, - newRef0, - readRef, - readRef0, - writeRef, - writeRef0, - modifyRef, - modifyRef0, - topRefDefined0, - defineTopRef0, - defineTopRef0_) where - --- import Debug.Trace - -import Data.IORef -import qualified Data.IntMap as M - -import Control.Monad -import Control.Monad.Trans - -import Simulation.Aivika.Trans.Internal.Types -import Simulation.Aivika.Lattice.Internal.LIO - --- | A reference map. -type RefMap a = IORef (M.IntMap (IORef a)) - --- | A mutable reference. -newtype Ref a = Ref { refMap :: RefMap a - -- ^ the map of actual references - } - -instance Eq (Ref a) where - r1 == r2 = (refMap r1) == (refMap r2) - --- | Return the map index. -lioMapIndex :: LIOParams -> Int -lioMapIndex ps = ((i * (i + 1)) `div` 2) + k - where i = lioTimeIndex ps - k = lioMemberIndex ps - --- | Create an empty reference. -newEmptyRef :: Simulation LIO (Ref a) -newEmptyRef = Simulation $ const newEmptyRef0 - --- | Create an empty reference. -newEmptyRef0 :: LIO (Ref a) -newEmptyRef0 = - LIO $ \ps -> - do rm <- newIORef M.empty - return Ref { refMap = rm } - --- | Create a new reference. -newRef :: a -> Simulation LIO (Ref a) -newRef = Simulation . const . newRef0 - --- | Create a new reference. -newRef0 :: a -> LIO (Ref a) -newRef0 a = - LIO $ \ps -> - do r <- invokeLIO ps newEmptyRef0 - ra <- newIORef a - let !i = lioMapIndex ps - writeIORef (refMap r) $ - M.insert i ra M.empty - return r - --- | Read the value of a reference. -readRef :: Ref a -> Event LIO a -readRef = Event . const . readRef0 - --- | Read the value of a reference. -readRef0 :: Ref a -> LIO a -readRef0 r = - LIO $ \ps -> - do m <- readIORef (refMap r) - let loop ps = - case M.lookup (lioMapIndex ps) m of - Just ra -> readIORef ra - Nothing -> - case parentLIOParams ps of - Just ps' -> loop ps' - Nothing -> error "Cannot find lattice node: readRef0" - loop ps - --- | Write a new value into the reference. -writeRef :: Ref a -> a -> Event LIO () -writeRef r a = Event $ const $ writeRef0 r a - --- | Write a new value into the reference. -writeRef0 :: Ref a -> a -> LIO () -writeRef0 r a = - LIO $ \ps -> - do m <- readIORef (refMap r) - let !i = lioMapIndex ps - case M.lookup i m of - Just ra -> a `seq` writeIORef ra a - Nothing -> - do ra <- a `seq` newIORef a - modifyIORef (refMap r) $ M.insert i ra - --- | Mutate the contents of the reference. -modifyRef :: Ref a -> (a -> a) -> Event LIO () -modifyRef r f = Event $ const $ modifyRef0 r f - --- | Mutate the contents of the reference. -modifyRef0 :: Ref a -> (a -> a) -> LIO () -modifyRef0 r f = - LIO $ \ps -> - do m <- readIORef (refMap r) - let !i = lioMapIndex ps - case M.lookup i m of - Just ra -> - do a <- readIORef ra - let b = f a - b `seq` writeIORef ra b - Nothing -> - do a <- invokeLIO ps $ readRef0 r - invokeLIO ps $ writeRef0 r (f a) - --- | Whether the top reference value is defined. -topRefDefined0 :: Ref a -> LIO Bool -topRefDefined0 r = - LIO $ \ps -> - do m <- readIORef (refMap r) - let !i = lioMapIndex ps - case M.lookup i m of - Just ra -> return True - Nothing -> return False - --- | Define the top reference value. -defineTopRef0 :: Ref a -> LIO a -defineTopRef0 r = - LIO $ \ps -> - do m <- readIORef (refMap r) - let !i = lioMapIndex ps - case M.lookup i m of - Just ra -> readIORef ra - Nothing -> - case parentLIOParams ps of - Nothing -> error "Cannot find parent: defineTopRef0" - Just ps' -> - do a <- invokeLIO ps' $ defineTopRef0 r - ra <- a `seq` newIORef a - modifyIORef (refMap r) $ M.insert i ra - return a + (module Simulation.Aivika.Lattice.Internal.Ref.Strict) where --- | Ensure that the top reference value is defined. -defineTopRef0_ :: Ref a -> LIO () -defineTopRef0_ r = - do a <- defineTopRef0 r - return () +import Simulation.Aivika.Lattice.Internal.Ref.Strict diff --git a/Simulation/Aivika/Lattice/Internal/Ref/Lazy.hs b/Simulation/Aivika/Lattice/Internal/Ref/Lazy.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Lattice/Internal/Ref/Lazy.hs @@ -0,0 +1,168 @@ + +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module : Simulation.Aivika.Lattice.Internal.Ref.Lazy +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.3 +-- +-- The implementation of lazy mutable references. +-- +module Simulation.Aivika.Lattice.Internal.Ref.Lazy + (Ref, + newEmptyRef, + newEmptyRef0, + newRef, + newRef0, + readRef, + readRef0, + writeRef, + writeRef0, + modifyRef, + modifyRef0, + topRefDefined0, + defineTopRef0, + defineTopRef0_) where + +-- import Debug.Trace + +import Data.IORef +import qualified Data.IntMap as M + +import Control.Monad +import Control.Monad.Trans + +import Simulation.Aivika.Trans.Internal.Types +import Simulation.Aivika.Lattice.Internal.LIO + +-- | A reference map. +type RefMap a = IORef (M.IntMap (IORef a)) + +-- | A lazy mutable reference. +newtype Ref a = Ref { refMap :: RefMap a + -- ^ the map of actual references + } + +instance Eq (Ref a) where + r1 == r2 = (refMap r1) == (refMap r2) + +-- | Return the map index. +lioMapIndex :: LIOParams -> Int +lioMapIndex ps = ((i * (i + 1)) `div` 2) + k + where i = lioTimeIndex ps + k = lioMemberIndex ps + +-- | Create an empty reference. +newEmptyRef :: Simulation LIO (Ref a) +newEmptyRef = Simulation $ const newEmptyRef0 + +-- | Create an empty reference. +newEmptyRef0 :: LIO (Ref a) +newEmptyRef0 = + LIO $ \ps -> + do rm <- newIORef M.empty + return Ref { refMap = rm } + +-- | Create a new reference. +newRef :: a -> Simulation LIO (Ref a) +newRef = Simulation . const . newRef0 + +-- | Create a new reference. +newRef0 :: a -> LIO (Ref a) +newRef0 a = + LIO $ \ps -> + do r <- invokeLIO ps newEmptyRef0 + ra <- newIORef a + let !i = lioMapIndex ps + writeIORef (refMap r) $ + M.insert i ra M.empty + return r + +-- | Read the value of a reference. +readRef :: Ref a -> Event LIO a +readRef = Event . const . readRef0 + +-- | Read the value of a reference. +readRef0 :: Ref a -> LIO a +readRef0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let loop ps = + case M.lookup (lioMapIndex ps) m of + Just ra -> readIORef ra + Nothing -> + case parentLIOParams ps of + Just ps' -> loop ps' + Nothing -> error "Cannot find lattice node: readRef0" + loop ps + +-- | Write a new value into the reference. +writeRef :: Ref a -> a -> Event LIO () +writeRef r a = Event $ const $ writeRef0 r a + +-- | Write a new value into the reference. +writeRef0 :: Ref a -> a -> LIO () +writeRef0 r a = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> writeIORef ra a + Nothing -> + do ra <- newIORef a + modifyIORef (refMap r) $ M.insert i ra + +-- | Mutate the contents of the reference. +modifyRef :: Ref a -> (a -> a) -> Event LIO () +modifyRef r f = Event $ const $ modifyRef0 r f + +-- | Mutate the contents of the reference. +modifyRef0 :: Ref a -> (a -> a) -> LIO () +modifyRef0 r f = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> + do a <- readIORef ra + let b = f a + writeIORef ra b + Nothing -> + do a <- invokeLIO ps $ readRef0 r + invokeLIO ps $ writeRef0 r (f a) + +-- | Whether the top reference value is defined. +topRefDefined0 :: Ref a -> LIO Bool +topRefDefined0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> return True + Nothing -> return False + +-- | Define the top reference value. +defineTopRef0 :: Ref a -> LIO a +defineTopRef0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> readIORef ra + Nothing -> + case parentLIOParams ps of + Nothing -> error "Cannot find parent: defineTopRef0" + Just ps' -> + do a <- invokeLIO ps' $ defineTopRef0 r + ra <- newIORef a + modifyIORef (refMap r) $ M.insert i ra + return a + +-- | Ensure that the top reference value is defined. +defineTopRef0_ :: Ref a -> LIO () +defineTopRef0_ r = + do a <- defineTopRef0 r + return () diff --git a/Simulation/Aivika/Lattice/Internal/Ref/Strict.hs b/Simulation/Aivika/Lattice/Internal/Ref/Strict.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Lattice/Internal/Ref/Strict.hs @@ -0,0 +1,168 @@ + +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module : Simulation.Aivika.Lattice.Internal.Ref.Strict +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.3 +-- +-- The implementation of strict mutable references. +-- +module Simulation.Aivika.Lattice.Internal.Ref.Strict + (Ref, + newEmptyRef, + newEmptyRef0, + newRef, + newRef0, + readRef, + readRef0, + writeRef, + writeRef0, + modifyRef, + modifyRef0, + topRefDefined0, + defineTopRef0, + defineTopRef0_) where + +-- import Debug.Trace + +import Data.IORef +import qualified Data.IntMap as M + +import Control.Monad +import Control.Monad.Trans + +import Simulation.Aivika.Trans.Internal.Types +import Simulation.Aivika.Lattice.Internal.LIO + +-- | A reference map. +type RefMap a = IORef (M.IntMap (IORef a)) + +-- | A strict mutable reference. +newtype Ref a = Ref { refMap :: RefMap a + -- ^ the map of actual references + } + +instance Eq (Ref a) where + r1 == r2 = (refMap r1) == (refMap r2) + +-- | Return the map index. +lioMapIndex :: LIOParams -> Int +lioMapIndex ps = ((i * (i + 1)) `div` 2) + k + where i = lioTimeIndex ps + k = lioMemberIndex ps + +-- | Create an empty reference. +newEmptyRef :: Simulation LIO (Ref a) +newEmptyRef = Simulation $ const newEmptyRef0 + +-- | Create an empty reference. +newEmptyRef0 :: LIO (Ref a) +newEmptyRef0 = + LIO $ \ps -> + do rm <- newIORef M.empty + return Ref { refMap = rm } + +-- | Create a new reference. +newRef :: a -> Simulation LIO (Ref a) +newRef = Simulation . const . newRef0 + +-- | Create a new reference. +newRef0 :: a -> LIO (Ref a) +newRef0 a = + LIO $ \ps -> + do r <- invokeLIO ps newEmptyRef0 + ra <- newIORef a + let !i = lioMapIndex ps + writeIORef (refMap r) $ + M.insert i ra M.empty + return r + +-- | Read the value of a reference. +readRef :: Ref a -> Event LIO a +readRef = Event . const . readRef0 + +-- | Read the value of a reference. +readRef0 :: Ref a -> LIO a +readRef0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let loop ps = + case M.lookup (lioMapIndex ps) m of + Just ra -> readIORef ra + Nothing -> + case parentLIOParams ps of + Just ps' -> loop ps' + Nothing -> error "Cannot find lattice node: readRef0" + loop ps + +-- | Write a new value into the reference. +writeRef :: Ref a -> a -> Event LIO () +writeRef r a = Event $ const $ writeRef0 r a + +-- | Write a new value into the reference. +writeRef0 :: Ref a -> a -> LIO () +writeRef0 r a = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> a `seq` writeIORef ra a + Nothing -> + do ra <- a `seq` newIORef a + modifyIORef (refMap r) $ M.insert i ra + +-- | Mutate the contents of the reference. +modifyRef :: Ref a -> (a -> a) -> Event LIO () +modifyRef r f = Event $ const $ modifyRef0 r f + +-- | Mutate the contents of the reference. +modifyRef0 :: Ref a -> (a -> a) -> LIO () +modifyRef0 r f = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> + do a <- readIORef ra + let b = f a + b `seq` writeIORef ra b + Nothing -> + do a <- invokeLIO ps $ readRef0 r + invokeLIO ps $ writeRef0 r (f a) + +-- | Whether the top reference value is defined. +topRefDefined0 :: Ref a -> LIO Bool +topRefDefined0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> return True + Nothing -> return False + +-- | Define the top reference value. +defineTopRef0 :: Ref a -> LIO a +defineTopRef0 r = + LIO $ \ps -> + do m <- readIORef (refMap r) + let !i = lioMapIndex ps + case M.lookup i m of + Just ra -> readIORef ra + Nothing -> + case parentLIOParams ps of + Nothing -> error "Cannot find parent: defineTopRef0" + Just ps' -> + do a <- invokeLIO ps' $ defineTopRef0 r + ra <- a `seq` newIORef a + modifyIORef (refMap r) $ M.insert i ra + return a + +-- | Ensure that the top reference value is defined. +defineTopRef0_ :: Ref a -> LIO () +defineTopRef0_ r = + do a <- defineTopRef0 r + return () diff --git a/Simulation/Aivika/Lattice/LIO.hs b/Simulation/Aivika/Lattice/LIO.hs --- a/Simulation/Aivika/Lattice/LIO.hs +++ b/Simulation/Aivika/Lattice/LIO.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Branch.LIO --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -30,7 +30,8 @@ import Simulation.Aivika.Lattice.Internal.LIO import Simulation.Aivika.Lattice.Event import Simulation.Aivika.Lattice.Generator -import Simulation.Aivika.Lattice.Ref.Base +import Simulation.Aivika.Lattice.Ref.Base.Lazy +import Simulation.Aivika.Lattice.Ref.Base.Strict import Simulation.Aivika.Lattice.QueueStrategy instance MonadDES LIO diff --git a/Simulation/Aivika/Lattice/QueueStrategy.hs b/Simulation/Aivika/Lattice/QueueStrategy.hs --- a/Simulation/Aivika/Lattice/QueueStrategy.hs +++ b/Simulation/Aivika/Lattice/QueueStrategy.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Lattice.QueueStrategy --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Lattice/Ref/Base.hs b/Simulation/Aivika/Lattice/Ref/Base.hs --- a/Simulation/Aivika/Lattice/Ref/Base.hs +++ b/Simulation/Aivika/Lattice/Ref/Base.hs @@ -1,59 +1,19 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} - -- | -- Module : Simulation.Aivika.Lattice.Ref.Base --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental -- Tested with: GHC 7.10.3 -- --- Here is an implementation of mutable references, where +-- Here is an implementation of strict mutable references, where -- 'LIO' is an instance of 'MonadRef' and 'MonadRef0'. -- -module Simulation.Aivika.Lattice.Ref.Base () where +module Simulation.Aivika.Lattice.Ref.Base + (module Simulation.Aivika.Lattice.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.Trans.Observable import Simulation.Aivika.Lattice.Internal.LIO -import qualified Simulation.Aivika.Lattice.Internal.Ref as R -import Simulation.Aivika.Lattice.Internal.Estimate -import Simulation.Aivika.Lattice.Internal.Event - --- | The implementation of mutable references. -instance MonadRef LIO where - - -- | The mutable reference. - newtype Ref LIO 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 LIO where - - {-# INLINE newRef0 #-} - newRef0 = fmap Ref . R.newRef0 - --- | An instance of the specified type class. -instance Observable (Ref LIO) (Estimate LIO) where - - {-# INLINE readObservable #-} - readObservable (Ref r) = estimateRef r +import Simulation.Aivika.Lattice.Ref.Base.Strict diff --git a/Simulation/Aivika/Lattice/Ref/Base/Lazy.hs b/Simulation/Aivika/Lattice/Ref/Base/Lazy.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Lattice/Ref/Base/Lazy.hs @@ -0,0 +1,59 @@ + +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} + +-- | +-- Module : Simulation.Aivika.Lattice.Ref.Base +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.3 +-- +-- Here is an implementation of lazy mutable references, where +-- 'LIO' is an instance of 'MonadRef' and 'MonadRef0'. +-- +module Simulation.Aivika.Lattice.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.Trans.Observable + +import Simulation.Aivika.Lattice.Internal.LIO +import qualified Simulation.Aivika.Lattice.Internal.Ref.Lazy as R +import Simulation.Aivika.Lattice.Internal.Estimate +import Simulation.Aivika.Lattice.Internal.Event + +-- | The implementation of mutable references. +instance MonadRef LIO where + + -- | The mutable reference. + newtype Ref LIO 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 LIO where + + {-# INLINE newRef0 #-} + newRef0 = fmap Ref . R.newRef0 + +-- | An instance of the specified type class. +instance Observable (Ref LIO) (Estimate LIO) where + + {-# INLINE readObservable #-} + readObservable (Ref r) = estimateLazyRef r diff --git a/Simulation/Aivika/Lattice/Ref/Base/Strict.hs b/Simulation/Aivika/Lattice/Ref/Base/Strict.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/Lattice/Ref/Base/Strict.hs @@ -0,0 +1,59 @@ + +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} + +-- | +-- Module : Simulation.Aivika.Lattice.Ref.Base.Strict +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 7.10.3 +-- +-- Here is an implementation of strict mutable references, where +-- 'LIO' is an instance of 'MonadRef' and 'MonadRef0'. +-- +module Simulation.Aivika.Lattice.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.Trans.Observable + +import Simulation.Aivika.Lattice.Internal.LIO +import qualified Simulation.Aivika.Lattice.Internal.Ref.Strict as R +import Simulation.Aivika.Lattice.Internal.Estimate +import Simulation.Aivika.Lattice.Internal.Event + +-- | The implementation of mutable references. +instance MonadRef LIO where + + -- | The mutable reference. + newtype Ref LIO 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 LIO where + + {-# INLINE newRef0 #-} + newRef0 = fmap Ref . R.newRef0 + +-- | An instance of the specified type class. +instance Observable (Ref LIO) (Estimate LIO) where + + {-# INLINE readObservable #-} + readObservable (Ref r) = estimateStrictRef r diff --git a/aivika-lattice.cabal b/aivika-lattice.cabal --- a/aivika-lattice.cabal +++ b/aivika-lattice.cabal @@ -1,19 +1,20 @@ name: aivika-lattice -version: 0.1.1 +version: 0.2 synopsis: Nested discrete event simulation module for the Aivika library using lattice description: - This experimental package extends the aivika-transformers [1] library with facilities for - running nested discrete event simulations within lattice nodes. + This experimental package extends the aivika-transformers [1] library and allows + running nested discrete event simulations within lattice nodes, because of which + traversing the nodes of branching has a quadratic complexity. . \[1] . category: Simulation license: BSD3 license-file: LICENSE -copyright: (c) 2016. David Sorokin +copyright: (c) 2016-2017. David Sorokin author: David Sorokin maintainer: David Sorokin -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 @@ -36,18 +37,22 @@ Simulation.Aivika.Lattice.LIO Simulation.Aivika.Lattice.QueueStrategy Simulation.Aivika.Lattice.Ref.Base + Simulation.Aivika.Lattice.Ref.Base.Lazy + Simulation.Aivika.Lattice.Ref.Base.Strict other-modules: Simulation.Aivika.Lattice.Internal.Event Simulation.Aivika.Lattice.Internal.Estimate Simulation.Aivika.Lattice.Internal.LIO Simulation.Aivika.Lattice.Internal.Ref + Simulation.Aivika.Lattice.Internal.Ref.Lazy + Simulation.Aivika.Lattice.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,