-- |
-- Module      : Streamly.Internal.Data.IORef.Unboxed
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- A mutable variable in a mutation capable monad (IO) holding a 'Unboxed'
-- value. This allows fast modification because of unboxed storage.
--
-- = Multithread Consistency Notes
--
-- In general, any value that straddles a machine word cannot be guaranteed to
-- be consistently read from another thread without a lock.  GHC heap objects
-- are always machine word aligned, therefore, a 'IORef' is also word aligned.
-- On a 64-bit platform, writing a 64-bit aligned type from one thread and
-- reading it from another thread should give consistent old or new value. The
-- same holds true for 32-bit values on a 32-bit platform.

module Streamly.Internal.Data.IORef.Unboxed
    (
      IORef

    -- Construction
    , newIORef

    -- Write
    , writeIORef
    , modifyIORef'

    -- Read
    , readIORef
    , pollIntIORef
    )
where

#include "inline.hs"

import Control.Monad.IO.Class (MonadIO(..))
import Data.Proxy (Proxy(..))
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf)

import qualified Streamly.Internal.Data.MutByteArray.Type as MBA
import qualified Streamly.Internal.Data.Stream.Type as D

-- | An 'IORef' holds a single 'Unbox'-able value.
newtype IORef a = IORef MutByteArray

-- | Create a new 'IORef'.
--
-- /Pre-release/
{-# INLINE newIORef #-}
newIORef :: forall a. Unbox a => a -> IO (IORef a)
newIORef :: forall a. Unbox a => a -> IO (IORef a)
newIORef a
x = do
    MutByteArray
var <- Int -> IO MutByteArray
MBA.new (Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
    Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
0 MutByteArray
var a
x
    IORef a -> IO (IORef a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef a -> IO (IORef a)) -> IORef a -> IO (IORef a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> IORef a
forall a. MutByteArray -> IORef a
IORef MutByteArray
var

-- | Write a value to an 'IORef'.
--
-- /Pre-release/
{-# INLINE writeIORef #-}
writeIORef :: Unbox a => IORef a -> a -> IO ()
writeIORef :: forall a. Unbox a => IORef a -> a -> IO ()
writeIORef (IORef MutByteArray
var) = Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
0 MutByteArray
var

-- | Read a value from an 'IORef'.
--
-- /Pre-release/
{-# INLINE readIORef #-}
readIORef :: Unbox a => IORef a -> IO a
readIORef :: forall a. Unbox a => IORef a -> IO a
readIORef (IORef MutByteArray
var) = Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
0 MutByteArray
var

-- | Modify the value of an 'IORef' using a function with strict application.
--
-- /Pre-release/
{-# INLINE modifyIORef' #-}
modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()
modifyIORef' :: forall a. Unbox a => IORef a -> (a -> a) -> IO ()
modifyIORef' IORef a
var a -> a
g = do
  a
x <- IORef a -> IO a
forall a. Unbox a => IORef a -> IO a
readIORef IORef a
var
  IORef a -> a -> IO ()
forall a. Unbox a => IORef a -> a -> IO ()
writeIORef IORef a
var (a -> a
g a
x)

-- | Generate a stream by continuously reading the IORef.
--
-- This operation reads the IORef without any synchronization. It can be
-- assumed to be atomic because the IORef (MutableByteArray) is always aligned
-- to Int boundaries, we are assuming that compiler uses single instructions to
-- access the memory. It may read stale values though until caches are
-- synchronised in a multiprocessor architecture.
--
-- /Pre-release/
{-# INLINE_NORMAL pollIntIORef #-}
pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a
pollIntIORef :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
IORef a -> Stream m a
pollIntIORef IORef a
var = (State StreamK m a -> () -> m (Step () a)) -> () -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m a -> () -> m (Step () a)
forall {m :: * -> *} {p}. MonadIO m => p -> () -> m (Step () a)
step ()

    where

    {-# INLINE_LATE step #-}
    step :: p -> () -> m (Step () a)
step p
_ () = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef a -> IO a
forall a. Unbox a => IORef a -> IO a
readIORef IORef a
var) m a -> (a -> m (Step () a)) -> m (Step () a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Step () a -> m (Step () a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step () a -> m (Step () a)) -> Step () a -> m (Step () a)
forall a b. (a -> b) -> a -> b
$ a -> () -> Step () a
forall s a. a -> s -> Step s a
D.Yield a
x ()