git.iko.soy/streamly
on master help sign in
Replace Prim with Unboxed in Data.IORef
d58ebdcAdithya Kumar
core/src/Streamly/Internal/Data/IORef/Prim.hs+24−24
compare with master
unifiedsplit
@@ -9,7 +9,7 @@
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : GHC
10-- Portability : GHC
11--
11--
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'
13-- value. This allows fast modification because of unboxed storage.
13-- value. This allows fast modification because of unboxed storage.
14--
14--
15-- = Multithread Consistency Notes
15-- = Multithread Consistency Notes
@@ -24,7 +24,6 @@
24module Streamly.Internal.Data.IORef.Prim
24module Streamly.Internal.Data.IORef.Prim
25 (
25 (
26 IORef
26 IORef
27− , Prim
28
27
29 -- * Construction
28 -- * Construction
30 , newIORef
29 , newIORef
@@ -42,56 +41,57 @@ where
42#include "inline.hs"
41#include "inline.hs"
43
42
44import Control.Monad.IO.Class (MonadIO(..))
43import Control.Monad.IO.Class (MonadIO(..))
45−import Control.Monad.Primitive (primitive_)
44+import Streamly.Internal.Data.Unboxed
46−import Data.Primitive.Types (Prim, sizeOf#, readByteArray#, writeByteArray#)
45+ ( ArrayContents(..)
47−import GHC.Exts (MutableByteArray#, newByteArray#, RealWorld)
46+ , Unboxed(..)
48−import GHC.IO (IO(..))
47+ , peekWith
48+ , pokeWith
49+ , newUnpinnedArrayContents
50+ )
49
51
50import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
52import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
51
53
52−-- | An 'IORef' holds a single 'Prim' value.
54+-- | An 'IORef' holds a single 'Unboxed' value.
53−data IORef a = IORef (MutableByteArray# RealWorld)
55+newtype IORef a = IORef (ArrayContents a)
54
56
55-- | Create a new 'IORef'.
57-- | Create a new 'IORef'.
56--
58--
57-- /Pre-release/
59-- /Pre-release/
58{-# INLINE newIORef #-}
60{-# INLINE newIORef #-}
59−newIORef :: forall a. Prim a => a -> IO (IORef a)
61+newIORef :: forall a. Unboxed a => a -> IO (IORef a)
60−newIORef x = IO (\s# ->
62+newIORef x = do
61− case newByteArray# (sizeOf# (undefined :: a)) s# of
63+ var <- newUnpinnedArrayContents (sizeOf (undefined :: a))
62− (# s1#, arr# #) ->
64+ pokeWith var 0 x
63− case writeByteArray# arr# 0# x s1# of
65+ return $ IORef var
64− s2# -> (# s2#, IORef arr# #)
65− )
66
66
67-- | Write a value to an 'IORef'.
67-- | Write a value to an 'IORef'.
68--
68--
69-- /Pre-release/
69-- /Pre-release/
70{-# INLINE writeIORef #-}
70{-# INLINE writeIORef #-}
71−writeIORef :: Prim a => IORef a -> a -> IO ()
71+writeIORef :: Unboxed a => IORef a -> a -> IO ()
72−writeIORef (IORef arr#) x = primitive_ (writeByteArray# arr# 0# x)
72+writeIORef (IORef var) x = pokeWith var 0 x
73
73
74-- | Read a value from an 'IORef'.
74-- | Read a value from an 'IORef'.
75--
75--
76-- /Pre-release/
76-- /Pre-release/
77{-# INLINE readIORef #-}
77{-# INLINE readIORef #-}
78−readIORef :: Prim a => IORef a -> IO a
78+readIORef :: Unboxed a => IORef a -> IO a
79−readIORef (IORef arr#) = IO (readByteArray# arr# 0#)
79+readIORef (IORef var) = peekWith var 0
80
80
81-- | Modify the value of an 'IORef' using a function with strict application.
81-- | Modify the value of an 'IORef' using a function with strict application.
82--
82--
83-- /Pre-release/
83-- /Pre-release/
84{-# INLINE modifyIORef' #-}
84{-# INLINE modifyIORef' #-}
85−modifyIORef' :: Prim a => IORef a -> (a -> a) -> IO ()
85+modifyIORef' :: Unboxed a => IORef a -> (a -> a) -> IO ()
86−modifyIORef' (IORef arr#) g = primitive_ $ \s# ->
86+modifyIORef' var g = do
87− case readByteArray# arr# 0# s# of
87+ x <- readIORef var
88− (# s'#, a #) -> let a' = g a in a' `seq` writeByteArray# arr# 0# a' s'#
88+ writeIORef var (g x)
89
89
90-- | Generate a stream by continuously reading the IORef.
90-- | Generate a stream by continuously reading the IORef.
91--
91--
92-- /Pre-release/
92-- /Pre-release/
93{-# INLINE_NORMAL toStreamD #-}
93{-# 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
95toStreamD var = D.Stream step ()
95toStreamD var = D.Stream step ()
96
96
97 where
97 where
core/src/Streamly/Internal/Data/Time/Units.hs+4−4
@@ -51,7 +51,7 @@ where
51import Text.Printf (printf)
51import Text.Printf (printf)
52
52
53import Data.Int
53import Data.Int
54−import Data.Primitive.Types (Prim(..))
54+import Streamly.Internal.Data.Unboxed (Unboxed)
55import Streamly.Internal.Data.Time.TimeSpec
55import Streamly.Internal.Data.Time.TimeSpec
56
56
57-------------------------------------------------------------------------------
57-------------------------------------------------------------------------------
@@ -106,7 +106,7 @@ newtype NanoSecond64 = NanoSecond64 Int64
106 , Real
106 , Real
107 , Integral
107 , Integral
108 , Ord
108 , Ord
109− , Prim
109+ , Unboxed
110 )
110 )
111
111
112-- | An 'Int64' time representation with a microsecond resolution.
112-- | An 'Int64' time representation with a microsecond resolution.
@@ -121,7 +121,7 @@ newtype MicroSecond64 = MicroSecond64 Int64
121 , Real
121 , Real
122 , Integral
122 , Integral
123 , Ord
123 , Ord
124− , Prim
124+ , Unboxed
125 )
125 )
126
126
127-- | An 'Int64' time representation with a millisecond resolution.
127-- | An 'Int64' time representation with a millisecond resolution.
@@ -136,7 +136,7 @@ newtype MilliSecond64 = MilliSecond64 Int64
136 , Real
136 , Real
137 , Integral
137 , Integral
138 , Ord
138 , Ord
139− , Prim
139+ , Unboxed
140 )
140 )
141
141
142-------------------------------------------------------------------------------
142-------------------------------------------------------------------------------
core/src/Streamly/Internal/Data/Unboxed.hs+42−1
@@ -14,6 +14,7 @@ module Streamly.Internal.Data.Unboxed
14 , getMutableByteArray#
14 , getMutableByteArray#
15 , pin
15 , pin
16 , unpin
16 , unpin
17+ , newUnpinnedArrayContents
17 ) where
18 ) where
18
19
19#include "MachDeps.h"
20#include "MachDeps.h"
@@ -22,7 +23,7 @@ module Streamly.Internal.Data.Unboxed
22
23
23import Data.Complex (Complex((:+)), realPart)
24import Data.Complex (Complex((:+)), realPart)
24import GHC.Base (IO(..))
25import GHC.Base (IO(..))
25−import GHC.Int (Int32(..))
26+import GHC.Int (Int32(..), Int64(..))
26import GHC.Word (Word8(..), Word64(..))
27import GHC.Word (Word8(..), Word64(..))
27
28
28import GHC.Exts
29import GHC.Exts
@@ -47,6 +48,20 @@ touch :: ArrayContents a -> IO ()
47touch (ArrayContents contents) =
48touch (ArrayContents contents) =
48 IO $ \s -> case touch# contents s of s' -> (# s', () #)
49 IO $ \s -> case touch# contents s of s' -> (# s', () #)
49
50
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+
50-------------------------------------------------------------------------------
65-------------------------------------------------------------------------------
51-- Pinning & Unpinning
66-- Pinning & Unpinning
52-------------------------------------------------------------------------------
67-------------------------------------------------------------------------------
@@ -106,6 +121,7 @@ unpin arr@(ArrayContents marr#) =
106#define SIZEOF_WORD64_PRIMITIVE 8#
121#define SIZEOF_WORD64_PRIMITIVE 8#
107#define SIZEOF_HSDOUBLE_PRIMITIVE 8#
122#define SIZEOF_HSDOUBLE_PRIMITIVE 8#
108#define SIZEOF_INT32_PRIMITIVE 4#
123#define SIZEOF_INT32_PRIMITIVE 4#
124+#define SIZEOF_INT64_PRIMITIVE 8#
109
125
110#ifdef __GHCJS__
126#ifdef __GHCJS__
111#define WORD64TYP Word64#
127#define WORD64TYP Word64#
@@ -113,6 +129,12 @@ unpin arr@(ArrayContents marr#) =
113#define WORD64TYP Word#
129#define WORD64TYP Word#
114#endif
130#endif
115
131
132+#ifdef __GHCJS__
133+#define INT64TYP Int64#
134+#else
135+#define INT64TYP Int#
136+#endif
137+
116{-# INLINE readWord8ArrayAsWideChar# #-}
138{-# INLINE readWord8ArrayAsWideChar# #-}
117readWord8ArrayAsWideChar# ::
139readWord8ArrayAsWideChar# ::
118 MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
140 MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
@@ -149,6 +171,18 @@ writeWord8ArrayAsInt32# ::
149writeWord8ArrayAsInt32# arr# i# a# s# =
171writeWord8ArrayAsInt32# arr# i# a# s# =
150 writeInt32Array# arr# (quotInt# i# SIZEOF_INT32_PRIMITIVE) a# s#
172 writeInt32Array# arr# (quotInt# i# SIZEOF_INT32_PRIMITIVE) a# s#
151
173
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+
152{-# INLINE readWord8ArrayAsWord# #-}
186{-# INLINE readWord8ArrayAsWord# #-}
153readWord8ArrayAsWord# ::
187readWord8ArrayAsWord# ::
154 MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
188 MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
@@ -269,6 +303,13 @@ DERIVE_UNBOXED( Int
269 , readWord8ArrayAsInt#
303 , readWord8ArrayAsInt#
270 , writeWord8ArrayAsInt#)
304 , writeWord8ArrayAsInt#)
271
305
306+DERIVE_UNBOXED( Int64
307+ , I64#
308+ , SIZEOF_INT64
309+ , ALIGNMENT_INT64
310+ , readWord8ArrayAsInt64#
311+ , writeWord8ArrayAsInt64#)
312+
272DERIVE_UNBOXED( Word
313DERIVE_UNBOXED( Word
273 , W#
314 , W#
274 , SIZEOF_HSWORD
315 , SIZEOF_HSWORD
src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+2−2
@@ -89,7 +89,6 @@ where
89#include "inline.hs"
89#include "inline.hs"
90
90
91import Control.Monad.IO.Class (MonadIO(..))
91import Control.Monad.IO.Class (MonadIO(..))
92−import Data.Primitive.Types (Prim)
93import Data.Void (Void)
92import Data.Void (Void)
94import Streamly.Internal.Control.Concurrent (MonadAsync)
93import Streamly.Internal.Control.Concurrent (MonadAsync)
95import Streamly.Internal.Data.Unfold.Type (Unfold)
94import Streamly.Internal.Data.Unfold.Type (Unfold)
@@ -105,6 +104,7 @@ import Streamly.Internal.Data.Stream.Serial (SerialT)
105import Streamly.Internal.Data.Stream.WSerial (WSerialT)
104import Streamly.Internal.Data.Stream.WSerial (WSerialT)
106import Streamly.Internal.Data.Stream.Zip (ZipSerialM)
105import Streamly.Internal.Data.Stream.Zip (ZipSerialM)
107import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)
106import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)
107+import Streamly.Internal.Data.Unboxed (Unboxed)
108
108
109import qualified Streamly.Internal.Data.IORef.Prim as Prim
109import qualified Streamly.Internal.Data.IORef.Prim as Prim
110import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
110import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
@@ -660,5 +660,5 @@ fromCallback setCallback = concatM $ do
660-- /Pre-release/
660-- /Pre-release/
661--
661--
662{-# INLINE fromPrimIORef #-}
662{-# 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
664fromPrimIORef = fromStreamD . Prim.toStreamD
664fromPrimIORef = fromStreamD . Prim.toStreamD