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 ----- 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/RealTime.hs b/Simulation/Aivika/RealTime.hs --- a/Simulation/Aivika/RealTime.hs +++ b/Simulation/Aivika/RealTime.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.RealTime --- 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/RealTime/Comp.hs b/Simulation/Aivika/RealTime/Comp.hs --- a/Simulation/Aivika/RealTime/Comp.hs +++ b/Simulation/Aivika/RealTime/Comp.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.RealTime.Comp --- 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/RealTime/Event.hs b/Simulation/Aivika/RealTime/Event.hs --- a/Simulation/Aivika/RealTime/Event.hs +++ b/Simulation/Aivika/RealTime/Event.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.RealTime.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/RealTime/Generator.hs b/Simulation/Aivika/RealTime/Generator.hs --- a/Simulation/Aivika/RealTime/Generator.hs +++ b/Simulation/Aivika/RealTime/Generator.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.RealTime.Generator --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -33,8 +33,10 @@ data Generator (RT m) = Generator { generator01 :: RT m Double, -- ^ the generator of uniform numbers from 0 to 1 - generatorNormal01 :: RT m Double + generatorNormal01 :: RT m Double, -- ^ the generator of normal numbers with mean 0 and variance 1 + generatorSequenceNo :: RT m Int + -- ^ the generator of sequence numbers } {-# INLINE generateUniform #-} @@ -76,6 +78,9 @@ {-# INLINE generateDiscrete #-} generateDiscrete = generateDiscrete01 . generator01 + {-# INLINE generateSequenceNo #-} + generateSequenceNo = generatorSequenceNo + {-# INLINABLE newGenerator #-} newGenerator tp = case tp of @@ -100,8 +105,14 @@ {-# INLINABLE newRandomGenerator01 #-} 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. diff --git a/Simulation/Aivika/RealTime/Internal/Channel.hs b/Simulation/Aivika/RealTime/Internal/Channel.hs --- a/Simulation/Aivika/RealTime/Internal/Channel.hs +++ b/Simulation/Aivika/RealTime/Internal/Channel.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.RealTime.Internal.Channel --- 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/RealTime/Internal/Event.hs b/Simulation/Aivika/RealTime/Internal/Event.hs --- a/Simulation/Aivika/RealTime/Internal/Event.hs +++ b/Simulation/Aivika/RealTime/Internal/Event.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.RealTime.Internal.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/RealTime/Internal/RT.hs b/Simulation/Aivika/RealTime/Internal/RT.hs --- a/Simulation/Aivika/RealTime/Internal/RT.hs +++ b/Simulation/Aivika/RealTime/Internal/RT.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.RealTime.Internal.RT --- 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/RealTime/QueueStrategy.hs b/Simulation/Aivika/RealTime/QueueStrategy.hs --- a/Simulation/Aivika/RealTime/QueueStrategy.hs +++ b/Simulation/Aivika/RealTime/QueueStrategy.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.RealTime.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/RealTime/RT.hs b/Simulation/Aivika/RealTime/RT.hs --- a/Simulation/Aivika/RealTime/RT.hs +++ b/Simulation/Aivika/RealTime/RT.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.RealTime.RT --- Copyright : Copyright (c) 2016, David Sorokin +-- Copyright : Copyright (c) 2016-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -43,7 +43,8 @@ import Simulation.Aivika.RealTime.Event import Simulation.Aivika.RealTime.QueueStrategy import Simulation.Aivika.RealTime.Comp -import Simulation.Aivika.RealTime.Ref.Base +import Simulation.Aivika.RealTime.Ref.Base.Lazy +import Simulation.Aivika.RealTime.Ref.Base.Strict -- | An implementation of the 'MonadDES' type class. instance (Monad m, MonadIO m, MonadException m, MonadComp m) => MonadDES (RT m) where diff --git a/Simulation/Aivika/RealTime/Ref/Base.hs b/Simulation/Aivika/RealTime/Ref/Base.hs --- a/Simulation/Aivika/RealTime/Ref/Base.hs +++ b/Simulation/Aivika/RealTime/Ref/Base.hs @@ -1,66 +1,17 @@ -{-# LANGUAGE TypeFamilies #-} - -- | -- Module : Simulation.Aivika.RealTime.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 8.0.1 -- --- The 'RT' monad can be an instance of 'MonadRef'. +-- The 'RT' monad can be an instance of strict 'MonadRef'. -- -module Simulation.Aivika.RealTime.Ref.Base () where - -import Data.IORef - -import Control.Monad -import Control.Monad.Trans +module Simulation.Aivika.RealTime.Ref.Base + (module Simulation.Aivika.RealTime.Ref.Base.Strict) where -import Simulation.Aivika.Trans.Internal.Types import Simulation.Aivika.Trans.Ref.Base -import Simulation.Aivika.RealTime.Internal.RT - --- | The 'RT' monad is an instance of 'MonadRef'. -instance (Monad m, MonadIO m) => MonadRef (RT m) where - - {-# SPECIALISE instance MonadRef (RT IO) #-} - - -- | A type safe wrapper for the 'IORef' reference. - newtype Ref (RT m) a = Ref { refValue :: IORef a } - - {-# INLINE newRef #-} - newRef a = - Simulation $ \r -> - do x <- liftIO $ newIORef a - return Ref { refValue = x } - - {-# INLINE readRef #-} - readRef r = Event $ \p -> - liftIO $ readIORef (refValue r) - - {-# INLINE writeRef #-} - writeRef r a = Event $ \p -> - a `seq` liftIO $ writeIORef (refValue r) a - - {-# INLINE modifyRef #-} - modifyRef r f = Event $ \p -> - do a <- liftIO $ readIORef (refValue r) - let b = f a - b `seq` liftIO $ writeIORef (refValue r) b - - {-# INLINE equalRef #-} - equalRef (Ref r1) (Ref r2) = (r1 == r2) - --- | The 'RT' monad is an instance of 'MonadRef0'. -instance MonadIO m => MonadRef0 (RT m) where - - {-# SPECIALISE instance MonadRef0 (RT IO) #-} - - {-# INLINE newRef0 #-} - newRef0 a = - do x <- liftIO $ newIORef a - return Ref { refValue = x } - +import Simulation.Aivika.RealTime.Ref.Base.Strict diff --git a/Simulation/Aivika/RealTime/Ref/Base/Lazy.hs b/Simulation/Aivika/RealTime/Ref/Base/Lazy.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/RealTime/Ref/Base/Lazy.hs @@ -0,0 +1,66 @@ + +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Simulation.Aivika.RealTime.Ref.Base.Lazy +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 8.0.1 +-- +-- The 'RT' monad can be an instance of lazy 'MonadRef'. +-- +module Simulation.Aivika.RealTime.Ref.Base.Lazy () where + +import Data.IORef + +import Control.Monad +import Control.Monad.Trans + +import Simulation.Aivika.Trans.Internal.Types +import Simulation.Aivika.Trans.Ref.Base.Lazy + +import Simulation.Aivika.RealTime.Internal.RT + +-- | The 'RT' monad is an instance of 'MonadRef'. +instance (Monad m, MonadIO m) => MonadRef (RT m) where + + {-# SPECIALISE instance MonadRef (RT IO) #-} + + -- | A type safe wrapper for the 'IORef' reference. + newtype Ref (RT m) a = Ref { refValue :: IORef a } + + {-# INLINE newRef #-} + newRef a = + Simulation $ \r -> + do x <- liftIO $ newIORef a + return Ref { refValue = x } + + {-# INLINE readRef #-} + readRef r = Event $ \p -> + liftIO $ readIORef (refValue r) + + {-# INLINE writeRef #-} + writeRef r a = Event $ \p -> + liftIO $ writeIORef (refValue r) a + + {-# INLINE modifyRef #-} + modifyRef r f = Event $ \p -> + do a <- liftIO $ readIORef (refValue r) + let b = f a + liftIO $ writeIORef (refValue r) b + + {-# INLINE equalRef #-} + equalRef (Ref r1) (Ref r2) = (r1 == r2) + +-- | The 'RT' monad is an instance of 'MonadRef0'. +instance MonadIO m => MonadRef0 (RT m) where + + {-# SPECIALISE instance MonadRef0 (RT IO) #-} + + {-# INLINE newRef0 #-} + newRef0 a = + do x <- liftIO $ newIORef a + return Ref { refValue = x } + diff --git a/Simulation/Aivika/RealTime/Ref/Base/Strict.hs b/Simulation/Aivika/RealTime/Ref/Base/Strict.hs new file mode 100644 --- /dev/null +++ b/Simulation/Aivika/RealTime/Ref/Base/Strict.hs @@ -0,0 +1,66 @@ + +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Simulation.Aivika.RealTime.Ref.Base.Strict +-- Copyright : Copyright (c) 2016-2017, David Sorokin +-- License : BSD3 +-- Maintainer : David Sorokin +-- Stability : experimental +-- Tested with: GHC 8.0.1 +-- +-- The 'RT' monad can be an instance of strict 'MonadRef'. +-- +module Simulation.Aivika.RealTime.Ref.Base.Strict () where + +import Data.IORef + +import Control.Monad +import Control.Monad.Trans + +import Simulation.Aivika.Trans.Internal.Types +import Simulation.Aivika.Trans.Ref.Base.Strict + +import Simulation.Aivika.RealTime.Internal.RT + +-- | The 'RT' monad is an instance of 'MonadRef'. +instance (Monad m, MonadIO m) => MonadRef (RT m) where + + {-# SPECIALISE instance MonadRef (RT IO) #-} + + -- | A type safe wrapper for the 'IORef' reference. + newtype Ref (RT m) a = Ref { refValue :: IORef a } + + {-# INLINE newRef #-} + newRef a = + Simulation $ \r -> + do x <- liftIO $ newIORef a + return Ref { refValue = x } + + {-# INLINE readRef #-} + readRef r = Event $ \p -> + liftIO $ readIORef (refValue r) + + {-# INLINE writeRef #-} + writeRef r a = Event $ \p -> + a `seq` liftIO $ writeIORef (refValue r) a + + {-# INLINE modifyRef #-} + modifyRef r f = Event $ \p -> + do a <- liftIO $ readIORef (refValue r) + let b = f a + b `seq` liftIO $ writeIORef (refValue r) b + + {-# INLINE equalRef #-} + equalRef (Ref r1) (Ref r2) = (r1 == r2) + +-- | The 'RT' monad is an instance of 'MonadRef0'. +instance MonadIO m => MonadRef0 (RT m) where + + {-# SPECIALISE instance MonadRef0 (RT IO) #-} + + {-# INLINE newRef0 #-} + newRef0 a = + do x <- liftIO $ newIORef a + return Ref { refValue = x } + diff --git a/aivika-realtime.cabal b/aivika-realtime.cabal --- a/aivika-realtime.cabal +++ b/aivika-realtime.cabal @@ -1,5 +1,5 @@ name: aivika-realtime -version: 0.1.2 +version: 0.2 synopsis: Soft real-time simulation module for the Aivika library description: This package allows running soft real-time simulations based on the aivika-transformers [1] library. @@ -9,10 +9,10 @@ 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 @@ -30,6 +30,8 @@ Simulation.Aivika.RealTime.Generator Simulation.Aivika.RealTime.QueueStrategy Simulation.Aivika.RealTime.Ref.Base + Simulation.Aivika.RealTime.Ref.Base.Lazy + Simulation.Aivika.RealTime.Ref.Base.Strict Simulation.Aivika.RealTime.RT other-modules: Simulation.Aivika.RealTime.Internal.Channel @@ -43,8 +45,8 @@ random >= 1.0.0.3, async >= 2.0, time >= 1.5.0.1, - aivika >= 4.5, - aivika-transformers >= 4.6 + aivika >= 5.1, + aivika-transformers >= 5.1 extensions: TypeFamilies, MultiParamTypeClasses,