2983

pending completion

Build # 2983

Build Type

Pull #488

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/d997a219f17ce4159c57b94b575c023c4c1f5372">d997a219f<a href="https://github.com/composewell/streamly/commit/d997a219f17ce4159c57b94b575c023c4c1f5372">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/645d96a5a20c76353fc9090f04b00fd900addc8a">645d96a5a</a>">645d96a5a</a><a href="https://github.com/composewell/streamly/commit/d997a219f17ce4159c57b94b575c023c4c1f5372"> into ef7c6d963">ef7c6d963</a>

Pull Request Pull Request #488: Enhance the fold type to capture terminating folds

Run Details

489 of 489 new or added lines in 14 files covered. (100.0%)

3348 of 9470 relevant lines covered (35.35%)

0.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

28.95

/src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Types.hs

{-# LANGUAGE UnboxedTuples #-}

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Array.Prim.Pinned.Mut.Types
-- Copyright   : (c) 2020 Composewell Technologies
--
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
module Streamly.Internal.Data.Array.Prim.Pinned.Mut.Types
    (
      Array (..)

    -- * Construction
    , newArray
    , newAlignedArray
    , unsafeWriteIndex

    , spliceTwo
    , unsafeCopy

    , fromListM
    , fromListNM
    , fromStreamDN
    , fromStreamD

    -- * Streams of arrays
    , fromStreamDArraysOf

    , packArraysChunksOf
    , lpackArraysChunksOf

#if !defined(mingw32_HOST_OS)
--    , groupIOVecsOf
#endif

    -- * Elimination
    , unsafeReadIndex
    , length
    , byteLength

    , writeN
    , ArrayUnsafe(..)
    , writeNUnsafe
    , writeNAligned
    , write

    -- * Utilities
    , resizeArray
    , shrinkArray

    , touchArray
    , withArrayAsPtr
    )
where

import GHC.IO (IO(..))

#include "Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs"

-------------------------------------------------------------------------------
-- Allocation (Pinned)
-------------------------------------------------------------------------------

-- XXX we can use a single newArray routine which accepts an allocation
-- function which could be newByteArray#, newPinnedByteArray# or
-- newAlignedPinnedByteArray#. That function can go in the common include file.
--
-- | Allocate an array that is pinned and can hold 'count' items.  The memory of
-- the array is uninitialized.
--
-- Note that this is internal routine, the reference to this array cannot be
-- given out until the array has been written to and frozen.
{-# INLINE newArray #-}
newArray ::
       forall m a. (MonadIO m, Prim a)
    => Int
    -> m (Array a)
newArray (I# n#) =
    liftIO $ do
        let bytes = n# *# sizeOf# (undefined :: a)
        primitive $ \s# ->
            case newPinnedByteArray# bytes s# of
                (# s1#, arr# #) -> (# s1#, Array arr# #)

-- Change order of args?
-- | Allocate a new array aligned to the specified alignment and using pinned
-- memory.
{-# INLINE newAlignedArray #-}
newAlignedArray ::
       forall m a. (MonadIO m, Prim a)
    => Int -- size
    -> Int -- Alignment
    -> m (Array a)
newAlignedArray (I# n#) (I# a#) =
    liftIO $ do
        let bytes = n# *# sizeOf# (undefined :: a)
        primitive $ \s# ->
            case newAlignedPinnedByteArray# bytes a# s# of
                (# s1#, arr# #) -> (# s1#, Array arr# #)

-- | Resize (pinned) mutable byte array to new specified size (in elem
-- count). The returned array is either the original array resized in-place or,
-- if not possible, a newly allocated (pinned) array (with the original content
-- copied over).
{-# INLINE resizeArray #-}
resizeArray ::
       (MonadIO m, Prim a)
    => Array a
    -> Int -- ^ new size
    -> m (Array a)
resizeArray arr i = do
    len <- length arr
    if len == i
    then return arr
    else if i < len
         then shrinkArray arr i >> return arr
         else do
             nArr <- newArray i
             unsafeCopy nArr 0 arr 0 len
             return nArr

-------------------------------------------------------------------------------
-- Aligned Construction
-------------------------------------------------------------------------------

-- XXX we can also factor out common code in writeN and writeNAligned in the
-- same way as suggested above.
--
{-# INLINE_NORMAL writeNAligned #-}
writeNAligned ::
       (MonadIO m, Prim a)
    => Int
    -> Int
    -> Fold m a (Array a)
writeNAligned align limit = Fold step initial extract

    where

    initial = do
        marr <- newAlignedArray limit align
        return $ Tuple' marr 0

    extract (Tuple' marr len) = shrinkArray marr len >> return marr

    step s@(Tuple' marr i) x
        | i == limit = FL.Done <$> extract s
        | otherwise = do
            unsafeWriteIndex marr i x
            FL.partialM $ Tuple' marr (i + 1)

-------------------------------------------------------------------------------
-- Mutation with pointers
-------------------------------------------------------------------------------

-- XXX This section can probably go in a common include file for pinned arrays.

-- Change name later.
{-# INLINE toPtr #-}
toPtr :: Array a -> Ptr a
toPtr (Array arr#) = Ptr (byteArrayContents# (unsafeCoerce# arr#))

{-# INLINE touchArray #-}
touchArray :: Array a -> IO ()
touchArray arr = IO $ \s -> case touch# arr s of s' -> (# s', () #)

{-# INLINE withArrayAsPtr #-}
withArrayAsPtr :: Array a -> (Ptr a -> IO b) -> IO b
withArrayAsPtr arr f = do
    r <- f (toPtr arr)
    touchArray arr
    return r

1	{-# LANGUAGE UnboxedTuples #-}
2
3	#include "inline.hs"
4
5	-- \|
6	-- Module : Streamly.Internal.Data.Array.Prim.Pinned.Mut.Types
7	-- Copyright : (c) 2020 Composewell Technologies
8	--
9	-- License : BSD-3-Clause
10	-- Maintainer : streamly@composewell.com
11	-- Stability : experimental
12	-- Portability : GHC
13	--
14	module Streamly.Internal.Data.Array.Prim.Pinned.Mut.Types
15	(
16	Array (..)
17
18	-- * Construction
19	, newArray
20	, newAlignedArray
21	, unsafeWriteIndex
22
23	, spliceTwo
24	, unsafeCopy
25
26	, fromListM
27	, fromListNM
28	, fromStreamDN
29	, fromStreamD
30
31	-- * Streams of arrays
32	, fromStreamDArraysOf
33
34	, packArraysChunksOf
35	, lpackArraysChunksOf
36
37	#if !defined(mingw32_HOST_OS)
38	-- , groupIOVecsOf
39	#endif
40
41	-- * Elimination
42	, unsafeReadIndex
43	, length
44	, byteLength
45
46	, writeN
47	, ArrayUnsafe(..)
48	, writeNUnsafe
49	, writeNAligned
50	, write
51
52	-- * Utilities
53	, resizeArray
54	, shrinkArray
55
56	, touchArray
57	, withArrayAsPtr
58	)
59	where
60
61	import GHC.IO (IO(..))
62
63	#include "Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs"
64
65	-------------------------------------------------------------------------------
66	-- Allocation (Pinned)
67	-------------------------------------------------------------------------------
68
69	-- XXX we can use a single newArray routine which accepts an allocation
70	-- function which could be newByteArray#, newPinnedByteArray# or
71	-- newAlignedPinnedByteArray#. That function can go in the common include file.
72	--
73	-- \| Allocate an array that is pinned and can hold 'count' items. The memory of
74	-- the array is uninitialized.
75	--
76	-- Note that this is internal routine, the reference to this array cannot be
77	-- given out until the array has been written to and frozen.
78	{-# INLINE newArray #-}
79	newArray ::
80	forall m a. (MonadIO m, Prim a)
81	=> Int
82	-> m (Array a)
83	newArray (I# n#) =	1✔
84	liftIO $ do	1✔
85	let bytes = n# *# sizeOf# (undefined :: a)	×
86	primitive $ \s# ->	1✔
87	case newPinnedByteArray# bytes s# of	1✔
88	(# s1#, arr# #) -> (# s1#, Array arr# #)	1✔
89
90	-- Change order of args?
91	-- \| Allocate a new array aligned to the specified alignment and using pinned
92	-- memory.
93	{-# INLINE newAlignedArray #-}
94	newAlignedArray ::
95	forall m a. (MonadIO m, Prim a)
96	=> Int -- size
97	-> Int -- Alignment
98	-> m (Array a)
99	newAlignedArray (I# n#) (I# a#) =	×
100	liftIO $ do	×
101	let bytes = n# *# sizeOf# (undefined :: a)	×
102	primitive $ \s# ->	×
103	case newAlignedPinnedByteArray# bytes a# s# of	×
104	(# s1#, arr# #) -> (# s1#, Array arr# #)	×
105
106	-- \| Resize (pinned) mutable byte array to new specified size (in elem
107	-- count). The returned array is either the original array resized in-place or,
108	-- if not possible, a newly allocated (pinned) array (with the original content
109	-- copied over).
110	{-# INLINE resizeArray #-}
111	resizeArray ::
112	(MonadIO m, Prim a)
113	=> Array a
114	-> Int -- ^ new size
115	-> m (Array a)
116	resizeArray arr i = do	1✔
117	len <- length arr	1✔
118	if len == i	×
119	then return arr	×
120	else if i < len	×
121	then shrinkArray arr i >> return arr	×
122	else do	1✔
123	nArr <- newArray i	1✔
124	unsafeCopy nArr 0 arr 0 len	1✔
125	return nArr	1✔
126
127	-------------------------------------------------------------------------------
128	-- Aligned Construction
129	-------------------------------------------------------------------------------
130
131	-- XXX we can also factor out common code in writeN and writeNAligned in the
132	-- same way as suggested above.
133	--
134	{-# INLINE_NORMAL writeNAligned #-}
135	writeNAligned ::
136	(MonadIO m, Prim a)
137	=> Int
138	-> Int
139	-> Fold m a (Array a)
140	writeNAligned align limit = Fold step initial extract	×
141
142	where
143
144	initial = do	×
145	marr <- newAlignedArray limit align	×
146	return $ Tuple' marr 0	×
147
148	extract (Tuple' marr len) = shrinkArray marr len >> return marr	×
149
150	step s@(Tuple' marr i) x	×
151	\| i == limit = FL.Done <$> extract s	×
152	\| otherwise = do	×
153	unsafeWriteIndex marr i x	×
154	FL.partialM $ Tuple' marr (i + 1)	×
155
156	-------------------------------------------------------------------------------
157	-- Mutation with pointers
158	-------------------------------------------------------------------------------
159
160	-- XXX This section can probably go in a common include file for pinned arrays.
161
162	-- Change name later.
163	{-# INLINE toPtr #-}
164	toPtr :: Array a -> Ptr a
165	toPtr (Array arr#) = Ptr (byteArrayContents# (unsafeCoerce# arr#))	×
166
167	{-# INLINE touchArray #-}
168	touchArray :: Array a -> IO ()
169	touchArray arr = IO $ \s -> case touch# arr s of s' -> (# s', () #)	×
170
171	{-# INLINE withArrayAsPtr #-}
172	withArrayAsPtr :: Array a -> (Ptr a -> IO b) -> IO b
173	withArrayAsPtr arr f = do	×
174	r <- f (toPtr arr)	×
175	touchArray arr	×
176	return r	×

composewell / streamly / 2983

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous