2ac457f · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove unnecessary liftIO, add some comments

2ac457fHarendra Kumar3 years ago

core/src/Streamly/Internal/Data/Array.hs+3−5

compare with master

unifiedsplit

@@ -209,11 +209,9 @@ writeLastN n

209 in fmap f $ liftIO $ RB.new n

210

211 done (Tuple3Fused' rb rh i) = do

212− arr <- liftIO $ MA.new n

212+ arr <- MA.new n

213− foldFunc i rh snoc' arr rb

214−

215− -- XXX We should write a read unfold for ring.

213+ -- XXX We should write a read unfold for ring.

216− snoc' b a = liftIO $ MA.snocUnsafe b a

214+ foldFunc i rh MA.snocUnsafe arr rb

217

215

218 foldFunc i

216 foldFunc i

219 | i < n = RB.unsafeFoldRingM

217 | i < n = RB.unsafeFoldRingM

core/src/Streamly/Internal/Data/Array/Type.hs+1

@@ -923,6 +923,7 @@ instance Unbox a => IsList (Array a) where

923{-# INLINE byteCmp #-}

924byteCmp :: Array a -> Array a -> Ordering

925byteCmp arr1 arr2 =

926+ -- unsafePerformIO?

926 unsafeInlineIO $! unsafeThaw arr1 `MA.byteCmp` unsafeThaw arr2

927 unsafeInlineIO $! unsafeThaw arr1 `MA.byteCmp` unsafeThaw arr2

927

928

928-- | Byte equality of two arrays.

929-- | Byte equality of two arrays.

core/src/Streamly/Internal/Data/MutArray/Generic.hs+6−6

@@ -318,7 +318,7 @@ putIndices arr = FL.foldlM' step (return ())

318

319 where

320

321− step () (i, x) = liftIO (putIndex i arr x)

321+ step () (i, x) = putIndex i arr x

322

323-- | Modify a given index of an array using a modifier function without checking

324-- the bounds.

@@ -636,17 +636,17 @@ writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial

636

637 initial = do

638 when (elemCount < 0) $ error "writeWith: elemCount is negative"

639− liftIO $ new elemCount

639+ new elemCount

640

641 step arr@(MutArray _ start end bound) x

642 | end == bound = do

643 let oldSize = end - start

644 newSize = max (oldSize * 2) 1

645− arr1 <- liftIO $ realloc newSize arr

645+ arr1 <- realloc newSize arr

646 snocUnsafe arr1 x

647 step arr x = snocUnsafe arr x

648

649− -- extract = liftIO . rightSize

649+ -- extract = rightSize

650 extract = return

651

652-- | Fold the whole input to a single array.

@@ -683,7 +683,7 @@ fromList xs = fromStream $ D.fromList xs

683{-# INLINABLE fromPureStream #-}

684fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)

685fromPureStream xs =

686− liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs

686+ D.fold write $ D.morphInner (return . runIdentity) xs

687

688-------------------------------------------------------------------------------

689-- Chunking

@@ -815,7 +815,7 @@ putSliceUnsafe src srcStart dst dstStart len = liftIO $ do

815

816{-# INLINE clone #-}

817clone :: MonadIO m => MutArray a -> m (MutArray a)

818−clone src = liftIO $ do

818+clone src = do

819 let len = arrLen src

820 dst <- new len

821 putSliceUnsafe src 0 dst 0 len

core/src/Streamly/Internal/Data/MutArray/Type.hs+47−45

@@ -581,7 +581,7 @@ putIndices arr = FL.foldlM' step (return ())

581

582 where

583

584− step () (i, x) = liftIO (putIndex i arr x)

584+ step () (i, x) = putIndex i arr x

585

586-- | Modify a given index of an array using a modifier function.

587--

@@ -777,9 +777,6 @@ arrayChunkBytes = 1024

777roundDownTo :: Int -> Int -> Int

778roundDownTo elemSize size = size - (size `mod` elemSize)

779

780−-- XXX See if resizing can be implemented by reading the old array as a stream

781−-- and then using writeN to the new array.

782−--

783-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.

780-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.

784-- Since this is not inlined Unboxed consrraint leads to dictionary passing

781-- Since this is not inlined Unboxed consrraint leads to dictionary passing

785-- which complicates some inspection tests.

782-- which complicates some inspection tests.

@@ -817,6 +814,10 @@ reallocExplicit elemSize newCapacityInBytes MutArray{..} = do

817 , arrBound = newCapInBytes

814 , arrBound = newCapInBytes

818 }

815 }

819

816

817+-- XXX Should these be called reallocBytes etc?

818+-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In

819+-- fact clone/pinnedClone can be implemented using reallocAs.

820+

820-- | @realloc newCapacity array@ reallocates the array to the specified

821-- | @realloc newCapacity array@ reallocates the array to the specified

821-- capacity in bytes.

822-- capacity in bytes.

822--

823--

@@ -858,6 +859,8 @@ reallocWith label capSizer minIncrBytes arr = do

858 , ". Please check the sizing function passed."

859 , ". Please check the sizing function passed."

859 ]

860 ]

860

861

862+-- XXX should be called expand/extend because it never shortens the array.

863+

861-- | @resize newCapacity array@ changes the total capacity of the array so that

864-- | @resize newCapacity array@ changes the total capacity of the array so that

862-- it is enough to hold the specified number of elements. Nothing is done if

865-- it is enough to hold the specified number of elements. Nothing is done if

863-- the specified capacity is less than the length of the array.

866-- the specified capacity is less than the length of the array.

@@ -871,13 +874,14 @@ resize :: forall m a. (MonadIO m, Unbox a) =>

871 Int -> MutArray a -> m (MutArray a)

874 Int -> MutArray a -> m (MutArray a)

872resize nElems arr@MutArray{..} = do

875resize nElems arr@MutArray{..} = do

873 let req = SIZE_OF(a) * nElems

876 let req = SIZE_OF(a) * nElems

877+ -- XXX Should use arrBound

874 len = arrEnd - arrStart

878 len = arrEnd - arrStart

875 if req < len

879 if req < len

876 then return arr

880 then return arr

877 else realloc req arr

881 else realloc req arr

878

882

879−-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'

883+-- | Like 'resize' but if the requested byte capacity is more than

880−-- then it is rounded up to the closest power of 2.

884+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.

881--

885--

882-- /Pre-release/

886-- /Pre-release/

883{-# INLINE resizeExp #-}

887{-# INLINE resizeExp #-}

@@ -889,6 +893,7 @@ resizeExp nElems arr@MutArray{..} = do

889 if req > largeObjectThreshold

893 if req > largeObjectThreshold

890 then roundUpToPower2 req

894 then roundUpToPower2 req

891 else req

895 else req

896+ -- XXX Should use arrBound

892 len = arrEnd - arrStart

897 len = arrEnd - arrStart

893 if req1 < len

898 if req1 < len

894 then return arr

899 then return arr

@@ -958,7 +963,7 @@ snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr

958{-# INLINE snocMay #-}

963{-# INLINE snocMay #-}

959snocMay :: forall m a. (MonadIO m, Unbox a) =>

964snocMay :: forall m a. (MonadIO m, Unbox a) =>

960 MutArray a -> a -> m (Maybe (MutArray a))

965 MutArray a -> a -> m (Maybe (MutArray a))

961−snocMay arr@MutArray{..} x = liftIO $ do

966+snocMay arr@MutArray{..} x = do

962 let newEnd = INDEX_NEXT(arrEnd,a)

967 let newEnd = INDEX_NEXT(arrEnd,a)

963 if newEnd <= arrBound

968 if newEnd <= arrBound

964 then Just <$> snocNewEnd newEnd arr x

969 then Just <$> snocNewEnd newEnd arr x

@@ -972,7 +977,7 @@ snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>

972 -> a

977 -> a

973 -> m (MutArray a)

978 -> m (MutArray a)

974snocWithRealloc sizer arr x = do

979snocWithRealloc sizer arr x = do

975− arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr

980+ arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr

976 snocUnsafe arr1 x

981 snocUnsafe arr1 x

977

982

978-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of

983-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of

@@ -994,7 +999,7 @@ snocWith :: forall m a. (MonadIO m, Unbox a) =>

994 -> MutArray a

999 -> MutArray a

995 -> a

1000 -> a

996 -> m (MutArray a)

1001 -> m (MutArray a)

997−snocWith allocSize arr x = liftIO $ do

1002+snocWith allocSize arr x = do

998 let newEnd = INDEX_NEXT(arrEnd arr,a)

1003 let newEnd = INDEX_NEXT(arrEnd arr,a)

999 if newEnd <= arrBound arr

1004 if newEnd <= arrBound arr

1000 then snocNewEnd newEnd arr x

1005 then snocNewEnd newEnd arr x

@@ -1114,7 +1119,7 @@ getIndicesWith = indexReaderWith

1114-- /Pre-release/

1119-- /Pre-release/

1115{-# INLINE indexReader #-}

1120{-# INLINE indexReader #-}

1116indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a

1121indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a

1117−indexReader = getIndicesWith liftIO

1122+indexReader = indexReaderWith liftIO

1118

1123

1119-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold

1124-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold

1120{-# DEPRECATED getIndices "Please use indexReader instead." #-}

1125{-# DEPRECATED getIndices "Please use indexReader instead." #-}

@@ -2002,7 +2007,7 @@ writeWithAs ps elemCount =

2002

2007

2003 initial = do

2008 initial = do

2004 when (elemCount < 0) $ error "writeWith: elemCount is negative"

2009 when (elemCount < 0) $ error "writeWith: elemCount is negative"

2005− liftIO $ newAs ps elemCount

2010+ newAs ps elemCount

2006

2011

2007 step arr@(MutArray _ start end bound) x

2012 step arr@(MutArray _ start end bound) x

2008 | INDEX_NEXT(end,a) > bound = do

2013 | INDEX_NEXT(end,a) > bound = do

@@ -2073,7 +2078,7 @@ pinnedWrite =

2073fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)

2078fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)

2074 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)

2079 => PinnedState -> Int -> D.Stream m a -> m (MutArray a)

2075fromStreamDNAs ps limit str = do

2080fromStreamDNAs ps limit str = do

2076− (arr :: MutArray a) <- liftIO $ newAs ps limit

2081+ (arr :: MutArray a) <- newAs ps limit

2077 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str

2082 end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str

2078 return $ arr {arrEnd = end}

2083 return $ arr {arrEnd = end}

2079

2084

@@ -2123,13 +2128,13 @@ fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs

2123fromPureStreamN :: (MonadIO m, Unbox a) =>

2128fromPureStreamN :: (MonadIO m, Unbox a) =>

2124 Int -> Stream Identity a -> m (MutArray a)

2129 Int -> Stream Identity a -> m (MutArray a)

2125fromPureStreamN n xs =

2130fromPureStreamN n xs =

2126− liftIO $ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs

2131+ D.fold (writeN n) $ D.morphInner (return . runIdentity) xs

2127

2132

2128-- | Convert a pure stream in Identity monad to a mutable array.

2133-- | Convert a pure stream in Identity monad to a mutable array.

2129{-# INLINABLE fromPureStream #-}

2134{-# INLINABLE fromPureStream #-}

2130fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)

2135fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)

2131fromPureStream xs =

2136fromPureStream xs =

2132− liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs

2137+ D.fold write $ D.morphInner (return . runIdentity) xs

2133

2138

2134{-# INLINABLE fromPtrN #-}

2139{-# INLINABLE fromPtrN #-}

2135fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)

2140fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)

@@ -2175,7 +2180,7 @@ fromChunksRealloced s = do

2175 arr <- D.foldlM' spliceExp (pure a) strm

2180 arr <- D.foldlM' spliceExp (pure a) strm

2176 -- Reallocation is exponential so there may be 50% empty space in

2181 -- Reallocation is exponential so there may be 50% empty space in

2177 -- worst case. One more reallocation to reclaim the space.

2182 -- worst case. One more reallocation to reclaim the space.

2178− liftIO $ rightSize arr

2183+ rightSize arr

2179 Nothing -> pure nil

2184 Nothing -> pure nil

2180

2185

2181-------------------------------------------------------------------------------

2186-------------------------------------------------------------------------------

@@ -2287,7 +2292,7 @@ cloneAs ::

2287 )

2292 )

2288 => PinnedState -> MutArray a -> m (MutArray a)

2293 => PinnedState -> MutArray a -> m (MutArray a)

2289cloneAs ps src =

2294cloneAs ps src =

2290− liftIO $ do

2295+ do

2291 let startSrc = arrStart src

2296 let startSrc = arrStart src

2292 srcLen = arrEnd src - startSrc

2297 srcLen = arrEnd src - startSrc

2293 newArrContents <-

2298 newArrContents <-

@@ -2326,17 +2331,16 @@ spliceCopy :: forall m a. MonadIO m =>

2326 Unbox a =>

2331 Unbox a =>

2327#endif

2332#endif

2328 MutArray a -> MutArray a -> m (MutArray a)

2333 MutArray a -> MutArray a -> m (MutArray a)

2329−spliceCopy arr1 arr2 = liftIO $ do

2334+spliceCopy arr1 arr2 = do

2330 let start1 = arrStart arr1

2335 let start1 = arrStart arr1

2331 start2 = arrStart arr2

2336 start2 = arrStart arr2

2332 len1 = arrEnd arr1 - start1

2337 len1 = arrEnd arr1 - start1

2333 len2 = arrEnd arr2 - start2

2338 len2 = arrEnd arr2 - start2

2334− let newLen = len1 + len2

2339+ let len = len1 + len2

2335 newArrContents <-

2340 newArrContents <-

2336 if Unboxed.isPinned (arrContents arr1)

2341 if Unboxed.isPinned (arrContents arr1)

2337− then Unboxed.pinnedNew newLen

2342+ then liftIO $ Unboxed.pinnedNew len

2338− else Unboxed.new newLen

2343+ else liftIO $ Unboxed.new len

2339− let len = len1 + len2

2340 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1

2344 putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1

2341 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2

2345 putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2

2342 return $ MutArray newArrContents 0 len len

2346 return $ MutArray newArrContents 0 len len

@@ -2348,7 +2352,7 @@ spliceCopy arr1 arr2 = liftIO $ do

2348spliceUnsafe :: MonadIO m =>

2352spliceUnsafe :: MonadIO m =>

2349 MutArray a -> MutArray a -> m (MutArray a)

2353 MutArray a -> MutArray a -> m (MutArray a)

2350spliceUnsafe dst src =

2354spliceUnsafe dst src =

2351− liftIO $ do

2355+ do

2352 let startSrc = arrStart src

2356 let startSrc = arrStart src

2353 srcLen = arrEnd src - startSrc

2357 srcLen = arrEnd src - startSrc

2354 endDst = arrEnd dst

2358 endDst = arrEnd dst

@@ -2386,7 +2390,7 @@ spliceWith sizer dst@(MutArray _ start end bound) src = do

2386 $ "splice: newSize is less than the total size "

2390 $ "splice: newSize is less than the total size "

2387 ++ "of arrays being appended. Please check the "

2391 ++ "of arrays being appended. Please check the "

2388 ++ "sizer function passed."

2392 ++ "sizer function passed."

2389− liftIO $ realloc newSizeInBytes dst

2393+ realloc newSizeInBytes dst

2390 else return dst

2394 else return dst

2391 spliceUnsafe dst1 src

2395 spliceUnsafe dst1 src

2392

2396

@@ -2584,28 +2588,26 @@ asUnpinnedPtrUnsafe arr f =

2584-- /Pre-release/

2588-- /Pre-release/

2585{-# INLINE byteCmp #-}

2589{-# INLINE byteCmp #-}

2586byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering

2590byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering

2587−byteCmp arr1 arr2 =

2591+byteCmp arr1 arr2 = do

2588− liftIO

2589− $ do

2590− let marr1 = getMutableByteArray# (arrContents arr1)

2592+ let marr1 = getMutableByteArray# (arrContents arr1)

2591− marr2 = getMutableByteArray# (arrContents arr2)

2593+ marr2 = getMutableByteArray# (arrContents arr2)

2592− !(I# st1#) = arrStart arr1

2594+ !(I# st1#) = arrStart arr1

2593− !(I# st2#) = arrStart arr2

2595+ !(I# st2#) = arrStart arr2

2594− !(I# len#) = byteLength arr1

2596+ !(I# len#) = byteLength arr1

2595− case compare (byteLength arr1) (byteLength arr2) of

2597+ case compare (byteLength arr1) (byteLength arr2) of

2596− EQ -> do

2598+ EQ -> do

2597− r <- liftIO $ IO $ \s# ->

2599+ r <- liftIO $ IO $ \s# ->

2598− let res =

2600+ let res =

2599− I#

2601+ I#

2600− (compareByteArrays#

2602+ (compareByteArrays#

2601− (unsafeCoerce# marr1)

2603+ (unsafeCoerce# marr1)

2602− st1#

2604+ st1#

2603− (unsafeCoerce# marr2)

2605+ (unsafeCoerce# marr2)

2604− st2#

2606+ st2#

2605− len#)

2607+ len#)

2606− in (# s#, res #)

2608+ in (# s#, res #)

2607− return $ compare r 0

2609+ return $ compare r 0

2608− x -> return x

2610+ x -> return x

2609

2611

2610{-# INLINE cmp #-}

2612{-# INLINE cmp #-}

2611{-# DEPRECATED cmp "Please use byteCmp instead." #-}

2613{-# DEPRECATED cmp "Please use byteCmp instead." #-}

core/src/Streamly/Internal/Data/MutByteArray/Type.hs+3

@@ -83,6 +83,9 @@ touch :: MutByteArray -> IO ()

83touch (MutByteArray contents) =

84 IO $ \s -> case touch# contents s of s' -> (# s', () #)

86+-- XXX Some functions in this module are "IO" and others are "m", we need to

87+-- make it consistent.

88+

86-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted

89-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted

87-- pointer to the FFI call. For unsafe calls we do not need to pin the array.

90-- pointer to the FFI call. For unsafe calls we do not need to pin the array.

88-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in

91-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in