2818

pending completion

Build # 2818

Build Type

Pull #550

travis-ci-com

Committed by

web-flow

Commit Message

<a href="https://github.com/composewell/streamly/commit/<a class=hub.com/composewell/streamly/commit/b42d88f733b981f48ef6f288661d8dcb4949fff6">b42d88f73<a href="https://github.com/composewell/streamly/commit/b42d88f733b981f48ef6f288661d8dcb4949fff6">">Merge </a><a class="double-link" href="https://github.com/composewell/streamly/commit/<a class="double-link" href="https://github.com/composewell/streamly/commit/4b2674177affb34d56cd262b51a09ea7d4e5bae1">4b2674177</a>">4b2674177</a><a href="https://github.com/composewell/streamly/commit/b42d88f733b981f48ef6f288661d8dcb4949fff6"> into a18f1b57b">a18f1b57b</a>

Pull Request Pull Request #550: Extend Prim Array to be the default

Run Details

132 of 132 new or added lines in 9 files covered. (100.0%)

3092 of 8604 relevant lines covered (35.94%)

0.36 hits per line

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

60.53

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

{-# LANGUAGE CPP                       #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash                 #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE UnboxedTuples             #-}
{-# LANGUAGE FlexibleContexts          #-}

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Data.Prim.Pinned.Mutable.Array.Types
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
module Streamly.Internal.Data.Prim.Pinned.Mutable.Array.Types
    (
      Array (..)

    -- * Construction
    , newArray
    , newAlignedArray
    , writeArray

    , spliceTwo
    , unsafeCopy

    , fromListM
    , fromListNM
    , fromStreamDN
    , fromStreamD

    -- * Streams of arrays
    , fromStreamDArraysOf

    , packArraysChunksOf
    , lpackArraysChunksOf

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

    -- * Elimination
    , unsafeIndexM
    , length
    , byteLength

    , writeN
    , writeNAligned
    , write

    -- * Utilities
    , resizeArray
    , shrinkArray

    , fPlainPtrToW8Array
    , touchArray
    , withArrayAsPtr
    )
where

import Data.Word (Word8)
import GHC.ForeignPtr
import GHC.IO (IO(..))

#include "mutable-prim-array-types.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. (PrimMonad m, Prim a)
    => Int
    -> m (Array (PrimState m) a)
newArray (I# n#) =
    primitive $ \s# ->
        let bytes = n# *# sizeOf# (undefined :: a)
         in 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. (PrimMonad m, Prim a)
    => Int -- size
    -> Int -- Alignment
    -> m (Array (PrimState m) a)
newAlignedArray (I# n#) (I# a#) =
    primitive $ \s# ->
        let bytes = n# *# sizeOf# (undefined :: a)
         in 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 ::
       forall m a. (PrimMonad m, Prim a)
    => Array (PrimState m) a
    -> Int -- ^ new size
    -> m (Array (PrimState m) a)
resizeArray arr i =
    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

    where

    len = length arr

-------------------------------------------------------------------------------
-- 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 ::
       forall m a. (PrimMonad m, Prim a)
    => Int
    -> Int
    -> Fold m a (Array (PrimState m) a)
writeNAligned align limit = Fold step initial extract

    where

    initial = do
        marr <- newAlignedArray limit align
        return (marr, 0)

    step (marr, i) x
        | i == limit = return (marr, i)
        | otherwise = do
            writeArray marr i x
            return (marr, i + 1)

    extract (marr, len) = shrinkArray marr len >> return marr

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

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

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

-- XXX remove this?
fPlainPtrToW8Array :: ForeignPtr a -> Array RealWorld Word8
fPlainPtrToW8Array (ForeignPtr _ (PlainPtr mb)) = Array mb
fPlainPtrToW8Array _ =
    error "fPlainPtrToW8Array can only be used when the ForeignPtr does not have finalizers."

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

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

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

composewell / streamly / 2818

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