git.iko.soy/streamly
on 70fbefe help sign in
streamly/src/Streamly/Internal/Data/IORef/Prim.hs
100 lines 2.9 kB history raw
1{-# LANGUAGE UnboxedTuples #-}
3-- |
4-- Module : Streamly.Internal.Data.IORef.Prim
5-- Copyright : (c) 2019 Composewell Technologies
6--
7-- License : BSD3
8-- Maintainer : streamly@composewell.com
9-- Stability : experimental
10-- Portability : GHC
11--
12-- A mutable variable in a mutation capable monad (IO) holding a 'Prim'
13-- value. This allows fast modification because of unboxed storage.
14--
15-- = Multithread Consistency Notes
16--
17-- In general, any value that straddles a machine word cannot be guaranteed to
18-- be consistently read from another thread without a lock. GHC heap objects
19-- are always machine word aligned, therefore, a 'IORef' is also word aligned.
20-- On a 64-bit platform, writing a 64-bit aligned type from one thread and
21-- reading it from another thread should give consistent old or new value. The
22-- same holds true for 32-bit values on a 32-bit platform.
24module Streamly.Internal.Data.IORef.Prim
25 (
26 IORef
27 , Prim
29 -- * Construction
30 , newIORef
32 -- * Write
33 , writeIORef
34 , modifyIORef'
36 -- * Read
37 , readIORef
38 , toStreamD
39 )
40where
42#include "inline.hs"
44import Control.Monad.IO.Class (MonadIO(..))
45import Control.Monad.Primitive (primitive_)
46import Data.Primitive.Types (Prim, sizeOf#, readByteArray#, writeByteArray#)
47import GHC.Exts (MutableByteArray#, newByteArray#, RealWorld)
48import GHC.IO (IO(..))
50import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
52-- | An 'IORef' holds a single 'Prim' value.
53data IORef a = IORef (MutableByteArray# RealWorld)
55-- | Create a new 'IORef'.
56--
57-- /Pre-release/
58{-# INLINE newIORef #-}
59newIORef :: forall a. Prim a => a -> IO (IORef a)
60newIORef x = IO (\s# ->
61 case newByteArray# (sizeOf# (undefined :: a)) s# of
62 (# s1#, arr# #) ->
63 case writeByteArray# arr# 0# x s1# of
64 s2# -> (# s2#, IORef arr# #)
65 )
67-- | Write a value to an 'IORef'.
68--
69-- /Pre-release/
70{-# INLINE writeIORef #-}
71writeIORef :: Prim a => IORef a -> a -> IO ()
72writeIORef (IORef arr#) x = primitive_ (writeByteArray# arr# 0# x)
74-- | Read a value from an 'IORef'.
75--
76-- /Pre-release/
77{-# INLINE readIORef #-}
78readIORef :: Prim a => IORef a -> IO a
79readIORef (IORef arr#) = IO (readByteArray# arr# 0#)
81-- | Modify the value of an 'IORef' using a function with strict application.
82--
83-- /Pre-release/
84{-# INLINE modifyIORef' #-}
85modifyIORef' :: Prim a => IORef a -> (a -> a) -> IO ()
86modifyIORef' (IORef arr#) g = primitive_ $ \s# ->
87 case readByteArray# arr# 0# s# of
88 (# s'#, a #) -> let a' = g a in a' `seq` writeByteArray# arr# 0# a' s'#
90-- | Generate a stream by continuously reading the IORef.
91--
92-- /Pre-release/
93{-# INLINE_NORMAL toStreamD #-}
94toStreamD :: (MonadIO m, Prim a) => IORef a -> D.Stream m a
95toStreamD var = D.Stream step ()
97 where
99 {-# INLINE_LATE step #-}
100 step _ () = liftIO (readIORef var) >>= \x -> return $ D.Yield x ()