git.iko.soy/streamly
on master help sign in
Replace Prim with Unboxed in Data.IORef
commitd58ebdc7b37f93c751de80a0c002b6dd6974fe57 authorAdithya Kumar <adithya@composewell.com> dateFri 29 Jul 2022, 19:46 (4 years ago) parent4015d54
4 files changed+72−31
compare with master
unifiedsplit
core/src/Streamly/Internal/Data/IORef/Prim.hs+24−24 core/src/Streamly/Internal/Data/Time/Units.hs+4−4 core/src/Streamly/Internal/Data/Unboxed.hs+42−1 src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+2−2
core/src/Streamly/Internal/Data/IORef/Prim.hs+24−24
@@ -9,7 +9,7 @@
99-- Stability : experimental
1010-- Portability : GHC
1111--
12−-- A mutable variable in a mutation capable monad (IO) holding a 'Prim'
12+-- A mutable variable in a mutation capable monad (IO) holding a 'Unboxed'
1313-- value. This allows fast modification because of unboxed storage.
1414--
1515-- = Multithread Consistency Notes
@@ -24,7 +24,6 @@
2424module Streamly.Internal.Data.IORef.Prim
2525 (
2626 IORef
27− , Prim
2827
2928 -- * Construction
3029 , newIORef
@@ -42,56 +41,57 @@ where
4241#include "inline.hs"
4342
4443import Control.Monad.IO.Class (MonadIO(..))
45−import Control.Monad.Primitive (primitive_)
46−import Data.Primitive.Types (Prim, sizeOf#, readByteArray#, writeByteArray#)
47−import GHC.Exts (MutableByteArray#, newByteArray#, RealWorld)
48−import GHC.IO (IO(..))
44+import Streamly.Internal.Data.Unboxed
45+ ( ArrayContents(..)
46+ , Unboxed(..)
47+ , peekWith
48+ , pokeWith
49+ , newUnpinnedArrayContents
50+ )
4951
5052import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
5153
52−-- | An 'IORef' holds a single 'Prim' value.
53−data IORef a = IORef (MutableByteArray# RealWorld)
54+-- | An 'IORef' holds a single 'Unboxed' value.
55+newtype IORef a = IORef (ArrayContents a)
5456
5557-- | Create a new 'IORef'.
5658--
5759-- /Pre-release/
5860{-# INLINE newIORef #-}
59−newIORef :: forall a. Prim a => a -> IO (IORef a)
60−newIORef 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− )
61+newIORef :: forall a. Unboxed a => a -> IO (IORef a)
62+newIORef x = do
63+ var <- newUnpinnedArrayContents (sizeOf (undefined :: a))
64+ pokeWith var 0 x
65+ return $ IORef var
6666
6767-- | Write a value to an 'IORef'.
6868--
6969-- /Pre-release/
7070{-# INLINE writeIORef #-}
71−writeIORef :: Prim a => IORef a -> a -> IO ()
72−writeIORef (IORef arr#) x = primitive_ (writeByteArray# arr# 0# x)
71+writeIORef :: Unboxed a => IORef a -> a -> IO ()
72+writeIORef (IORef var) x = pokeWith var 0 x
7373
7474-- | Read a value from an 'IORef'.
7575--
7676-- /Pre-release/
7777{-# INLINE readIORef #-}
78−readIORef :: Prim a => IORef a -> IO a
79−readIORef (IORef arr#) = IO (readByteArray# arr# 0#)
78+readIORef :: Unboxed a => IORef a -> IO a
79+readIORef (IORef var) = peekWith var 0
8080
8181-- | Modify the value of an 'IORef' using a function with strict application.
8282--
8383-- /Pre-release/
8484{-# INLINE modifyIORef' #-}
85−modifyIORef' :: Prim a => IORef a -> (a -> a) -> IO ()
86−modifyIORef' (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'#
85+modifyIORef' :: Unboxed a => IORef a -> (a -> a) -> IO ()
86+modifyIORef' var g = do
87+ x <- readIORef var
88+ writeIORef var (g x)
8989
9090-- | Generate a stream by continuously reading the IORef.
9191--
9292-- /Pre-release/
9393{-# INLINE_NORMAL toStreamD #-}
94−toStreamD :: (MonadIO m, Prim a) => IORef a -> D.Stream m a
94+toStreamD :: (MonadIO m, Unboxed a) => IORef a -> D.Stream m a
9595toStreamD var = D.Stream step ()
9696
9797 where
core/src/Streamly/Internal/Data/Time/Units.hs+4−4
@@ -51,7 +51,7 @@ where
5151import Text.Printf (printf)
5252
5353import Data.Int
54−import Data.Primitive.Types (Prim(..))
54+import Streamly.Internal.Data.Unboxed (Unboxed)
5555import Streamly.Internal.Data.Time.TimeSpec
5656
5757-------------------------------------------------------------------------------
@@ -106,7 +106,7 @@ newtype NanoSecond64 = NanoSecond64 Int64
106106 , Real
107107 , Integral
108108 , Ord
109− , Prim
109+ , Unboxed
110110 )
111111
112112-- | An 'Int64' time representation with a microsecond resolution.
@@ -121,7 +121,7 @@ newtype MicroSecond64 = MicroSecond64 Int64
121121 , Real
122122 , Integral
123123 , Ord
124− , Prim
124+ , Unboxed
125125 )
126126
127127-- | An 'Int64' time representation with a millisecond resolution.
@@ -136,7 +136,7 @@ newtype MilliSecond64 = MilliSecond64 Int64
136136 , Real
137137 , Integral
138138 , Ord
139− , Prim
139+ , Unboxed
140140 )
141141
142142-------------------------------------------------------------------------------
core/src/Streamly/Internal/Data/Unboxed.hs+42−1
@@ -14,6 +14,7 @@ module Streamly.Internal.Data.Unboxed
1414 , getMutableByteArray#
1515 , pin
1616 , unpin
17+ , newUnpinnedArrayContents
1718 ) where
1819
1920#include "MachDeps.h"
@@ -22,7 +23,7 @@ module Streamly.Internal.Data.Unboxed
2223
2324import Data.Complex (Complex((:+)), realPart)
2425import GHC.Base (IO(..))
25−import GHC.Int (Int32(..))
26+import GHC.Int (Int32(..), Int64(..))
2627import GHC.Word (Word8(..), Word64(..))
2728
2829import GHC.Exts
@@ -47,6 +48,20 @@ touch :: ArrayContents a -> IO ()
4748touch (ArrayContents contents) =
4849 IO $ \s -> case touch# contents s of s' -> (# s', () #)
4950
51+--------------------------------------------------------------------------------
52+-- Creation
53+--------------------------------------------------------------------------------
54+
55+{-# INLINE newUnpinnedArrayContents #-}
56+newUnpinnedArrayContents :: Int -> IO (ArrayContents a)
57+newUnpinnedArrayContents nbytes | nbytes < 0 =
58+ errorWithoutStackTrace "newUnpinnedArrayContents: size must be >= 0"
59+newUnpinnedArrayContents (I# nbytes) = IO $ \s ->
60+ case newByteArray# nbytes s of
61+ (# s', mbarr# #) ->
62+ let c = ArrayContents mbarr#
63+ in (# s', c #)
64+
5065-------------------------------------------------------------------------------
5166-- Pinning & Unpinning
5267-------------------------------------------------------------------------------
@@ -106,6 +121,7 @@ unpin arr@(ArrayContents marr#) =
106121#define SIZEOF_WORD64_PRIMITIVE 8#
107122#define SIZEOF_HSDOUBLE_PRIMITIVE 8#
108123#define SIZEOF_INT32_PRIMITIVE 4#
124+#define SIZEOF_INT64_PRIMITIVE 8#
109125
110126#ifdef __GHCJS__
111127#define WORD64TYP Word64#
@@ -113,6 +129,12 @@ unpin arr@(ArrayContents marr#) =
113129#define WORD64TYP Word#
114130#endif
115131
132+#ifdef __GHCJS__
133+#define INT64TYP Int64#
134+#else
135+#define INT64TYP Int#
136+#endif
137+
116138{-# INLINE readWord8ArrayAsWideChar# #-}
117139readWord8ArrayAsWideChar# ::
118140 MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
@@ -149,6 +171,18 @@ writeWord8ArrayAsInt32# ::
149171writeWord8ArrayAsInt32# arr# i# a# s# =
150172 writeInt32Array# arr# (quotInt# i# SIZEOF_INT32_PRIMITIVE) a# s#
151173
174+{-# INLINE readWord8ArrayAsInt64# #-}
175+readWord8ArrayAsInt64# ::
176+ MutableByteArray# d -> Int# -> State# d -> (# State# d, INT64TYP #)
177+readWord8ArrayAsInt64# arr# i# s# =
178+ readInt64Array# arr# (quotInt# i# SIZEOF_INT64_PRIMITIVE) s#
179+
180+{-# INLINE writeWord8ArrayAsInt64# #-}
181+writeWord8ArrayAsInt64# ::
182+ MutableByteArray# d -> Int# -> INT64TYP -> State# d -> State# d
183+writeWord8ArrayAsInt64# arr# i# a# s# =
184+ writeInt64Array# arr# (quotInt# i# SIZEOF_INT64_PRIMITIVE) a# s#
185+
152186{-# INLINE readWord8ArrayAsWord# #-}
153187readWord8ArrayAsWord# ::
154188 MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
@@ -269,6 +303,13 @@ DERIVE_UNBOXED( Int
269303 , readWord8ArrayAsInt#
270304 , writeWord8ArrayAsInt#)
271305
306+DERIVE_UNBOXED( Int64
307+ , I64#
308+ , SIZEOF_INT64
309+ , ALIGNMENT_INT64
310+ , readWord8ArrayAsInt64#
311+ , writeWord8ArrayAsInt64#)
312+
272313DERIVE_UNBOXED( Word
273314 , W#
274315 , SIZEOF_HSWORD
src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+2−2
@@ -89,7 +89,6 @@ where
8989#include "inline.hs"
9090
9191import Control.Monad.IO.Class (MonadIO(..))
92−import Data.Primitive.Types (Prim)
9392import Data.Void (Void)
9493import Streamly.Internal.Control.Concurrent (MonadAsync)
9594import Streamly.Internal.Data.Unfold.Type (Unfold)
@@ -105,6 +104,7 @@ import Streamly.Internal.Data.Stream.Serial (SerialT)
105104import Streamly.Internal.Data.Stream.WSerial (WSerialT)
106105import Streamly.Internal.Data.Stream.Zip (ZipSerialM)
107106import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)
107+import Streamly.Internal.Data.Unboxed (Unboxed)
108108
109109import qualified Streamly.Internal.Data.IORef.Prim as Prim
110110import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
@@ -660,5 +660,5 @@ fromCallback setCallback = concatM $ do
660660-- /Pre-release/
661661--
662662{-# INLINE fromPrimIORef #-}
663−fromPrimIORef :: (IsStream t, MonadIO m, Prim a) => Prim.IORef a -> t m a
663+fromPrimIORef :: (IsStream t, MonadIO m, Unboxed a) => Prim.IORef a -> t m a
664664fromPrimIORef = fromStreamD . Prim.toStreamD