{-# LANGUAGE TypeFamilies #-}
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
instance (Monad m, MonadIO m) => MonadRef (RT m) where
{-# SPECIALISE instance MonadRef (RT IO) #-}
newtype Ref (RT m) a = Ref { Ref (RT m) a -> IORef a
refValue :: IORef a }
{-# INLINE newRef #-}
newRef :: a -> Simulation (RT m) (Ref (RT m) a)
newRef a
a =
(Run (RT m) -> RT m (Ref (RT m) a))
-> Simulation (RT m) (Ref (RT m) a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run (RT m) -> RT m (Ref (RT m) a))
-> Simulation (RT m) (Ref (RT m) a))
-> (Run (RT m) -> RT m (Ref (RT m) a))
-> Simulation (RT m) (Ref (RT m) a)
forall a b. (a -> b) -> a -> b
$ \Run (RT m)
r ->
do IORef a
x <- IO (IORef a) -> RT m (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> RT m (IORef a)) -> IO (IORef a) -> RT m (IORef a)
forall a b. (a -> b) -> a -> b
$ a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a
Ref (RT m) a -> RT m (Ref (RT m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref :: forall (m :: * -> *) a. IORef a -> Ref (RT m) a
Ref { refValue :: IORef a
refValue = IORef a
x }
{-# INLINE readRef #-}
readRef :: Ref (RT m) a -> Event (RT m) a
readRef Ref (RT m) a
r = (Point (RT m) -> RT m a) -> Event (RT m) a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point (RT m) -> RT m a) -> Event (RT m) a)
-> (Point (RT m) -> RT m a) -> Event (RT m) a
forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
IO a -> RT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RT m a) -> IO a -> RT m a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Ref (RT m) a -> IORef a
forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r)
{-# INLINE writeRef #-}
writeRef :: Ref (RT m) a -> a -> Event (RT m) ()
writeRef Ref (RT m) a
r a
a = (Point (RT m) -> RT m ()) -> Event (RT m) ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point (RT m) -> RT m ()) -> Event (RT m) ())
-> (Point (RT m) -> RT m ()) -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
a
a a -> RT m () -> RT m ()
`seq` IO () -> RT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RT m ()) -> IO () -> RT m ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref (RT m) a -> IORef a
forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r) a
a
{-# INLINE modifyRef #-}
modifyRef :: Ref (RT m) a -> (a -> a) -> Event (RT m) ()
modifyRef Ref (RT m) a
r a -> a
f = (Point (RT m) -> RT m ()) -> Event (RT m) ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point (RT m) -> RT m ()) -> Event (RT m) ())
-> (Point (RT m) -> RT m ()) -> Event (RT m) ()
forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
do a
a <- IO a -> RT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RT m a) -> IO a -> RT m a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Ref (RT m) a -> IORef a
forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r)
let b :: a
b = a -> a
f a
a
a
b a -> RT m () -> RT m ()
`seq` IO () -> RT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RT m ()) -> IO () -> RT m ()
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Ref (RT m) a -> IORef a
forall (m :: * -> *) a. Ref (RT m) a -> IORef a
refValue Ref (RT m) a
r) a
b
{-# INLINE equalRef #-}
equalRef :: Ref (RT m) a -> Ref (RT m) a -> Bool
equalRef (Ref r1) (Ref r2) = (IORef a
r1 IORef a -> IORef a -> Bool
forall a. Eq a => a -> a -> Bool
== IORef a
r2)
instance MonadIO m => MonadRef0 (RT m) where
{-# SPECIALISE instance MonadRef0 (RT IO) #-}
{-# INLINE newRef0 #-}
newRef0 :: a -> RT m (Ref (RT m) a)
newRef0 a
a =
do IORef a
x <- IO (IORef a) -> RT m (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> RT m (IORef a)) -> IO (IORef a) -> RT m (IORef a)
forall a b. (a -> b) -> a -> b
$ a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a
Ref (RT m) a -> RT m (Ref (RT m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref :: forall (m :: * -> *) a. IORef a -> Ref (RT m) a
Ref { refValue :: IORef a
refValue = IORef a
x }