packages feed

primitive 0.7.3.0 → 0.7.4.0

raw patch · 10 files changed

+244/−146 lines, 10 filesdep +template-haskelldep −faildep −semigroupsdep ~basedep ~transformers

Dependencies added: template-haskell

Dependencies removed: fail, semigroups

Dependency ranges changed: base, transformers

Files

Data/Primitive/Array.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskellQuotes #-}  -- | -- Module      : Data.Primitive.Array@@ -47,15 +48,11 @@ import qualified Data.Foldable as Foldable import Control.Monad.Zip import Data.Foldable (Foldable(..), toList)-#if MIN_VERSION_base(4,9,0) import qualified GHC.ST as GHCST import qualified Data.Foldable as F import Data.Semigroup-#endif import Data.Functor.Identity-#if MIN_VERSION_base(4,10,0)-import GHC.Exts (runRW#)-#elif MIN_VERSION_base(4,9,0)+#if !MIN_VERSION_base(4,10,0) import GHC.Base (runRW#) #endif @@ -65,12 +62,43 @@ import Text.ParserCombinators.ReadP  import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))+import Language.Haskell.TH.Syntax (Lift (..))  -- | Boxed arrays. data Array a = Array   { array# :: Array# a }   deriving ( Typeable ) +instance Lift a => Lift (Array a) where+#if MIN_VERSION_template_haskell(2,16,0)+  liftTyped ary = case lst of+    [] -> [|| Array (emptyArray# (##)) ||]+    [x] -> [|| pure $! x ||]+    x : xs -> [|| unsafeArrayFromListN' len x xs ||]+#else+  lift ary = case lst of+    [] -> [| Array (emptyArray# (##)) |]+    [x] -> [| pure $! x |]+    x : xs -> [| unsafeArrayFromListN' len x xs |]+#endif+    where+      len = length ary+      lst = toList ary++-- | Strictly create an array from a nonempty list (represented as+-- a first element and a list of the rest) of a known length. If the length+-- of the list does not match the given length, this makes demons fly+-- out of your nose. We use it in the 'Lift' instance. If you edit the+-- splice and break it, you get to keep both pieces.+unsafeArrayFromListN' :: Int -> a -> [a] -> Array a+unsafeArrayFromListN' n y ys =+  createArray n y $ \ma ->+    let go !_ix [] = return ()+        go !ix (!x : xs) = do+            writeArray ma ix x+            go (ix+1) xs+    in go 1 ys+ #if MIN_VERSION_deepseq(1,4,3) instance NFData1 Array where   liftRnf r = Foldable.foldl' (\_ -> r) ()@@ -297,9 +325,6 @@ runArray   :: (forall s. ST s (MutableArray s a))   -> Array a-#if !MIN_VERSION_base(4,9,0)-runArray m = runST $ m >>= unsafeFreezeArray-#else /* Below, runRW# is available. */ runArray m = Array (runArray# m)  runArray#@@ -315,7 +340,6 @@ emptyArray# :: (# #) -> Array# a emptyArray# _ = case emptyArray of Array ar -> ar {-# NOINLINE emptyArray# #-}-#endif  -- | Create an array of the given size with a default value, -- apply the monadic function and freeze the result. If the@@ -331,9 +355,6 @@   -> a   -> (forall s. MutableArray s a -> ST s ())   -> Array a-#if !MIN_VERSION_base(4,9,0)-createArray 0 _ _ = emptyArray-#else -- This low-level business is designed to work with GHC's worker-wrapper -- transformation. A lot of the time, we don't actually need an Array -- constructor. By putting it on the outside, and being careful about@@ -342,7 +363,6 @@ -- their Array constructors, although they'll share their underlying -- Array#s. createArray 0 _ _ = Array (emptyArray# (# #))-#endif createArray n x f = runArray $ do   mary <- newArray n x   f mary@@ -364,11 +384,7 @@  -- | @since 0.6.4.0 instance Eq1 Array where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftEq = arrayLiftEq-#else-  eq1 = arrayLiftEq (==)-#endif  instance Eq (MutableArray s a) where   ma1 == ma2 = isTrue# (sameMutableArray# (marray# ma1) (marray# ma2))@@ -390,11 +406,7 @@  -- | @since 0.6.4.0 instance Ord1 Array where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftCompare = arrayLiftCompare-#else-  compare1 = arrayLiftCompare compare-#endif  instance Foldable Array where   -- Note: we perform the array lookups eagerly so we won't@@ -731,12 +743,21 @@       sz = sizeofArray (f err)       err = error "mfix for Data.Primitive.Array applied to strict function." -#if MIN_VERSION_base(4,9,0) -- | @since 0.6.3.0 instance Semigroup (Array a) where   (<>) = (<|>)   sconcat = mconcat . F.toList-#endif+  stimes n arr = case compare n 0 of+    LT -> die "stimes" "negative multiplier"+    EQ -> empty+    GT -> createArray (n' * sizeofArray arr) (die "stimes" "impossible") $ \ma ->+      let go i = if i < n'+            then do+              copyArray ma (i * sizeofArray arr) arr 0 (sizeofArray arr)+              go (i + 1)+            else return ()+      in go 0+    where n' = fromIntegral n :: Int  instance Monoid (Array a) where   mempty = empty@@ -764,11 +785,7 @@  -- | @since 0.6.4.0 instance Show1 Array where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftShowsPrec = arrayLiftShowsPrec-#else-  showsPrec1 = arrayLiftShowsPrec showsPrec showList-#endif  instance Read a => Read (Array a) where   readPrec = arrayLiftReadPrec readPrec readListPrec@@ -777,10 +794,8 @@ instance Read1 Array where #if MIN_VERSION_base(4,10,0)   liftReadPrec = arrayLiftReadPrec-#elif MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)-  liftReadsPrec = arrayLiftReadsPrec #else-  readsPrec1 = arrayLiftReadsPrec readsPrec readList+  liftReadsPrec = arrayLiftReadsPrec #endif  -- We're really forgiving here. We accept
Data/Primitive/ByteArray.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskellQuotes #-}  -- | -- Module      : Data.Primitive.ByteArray@@ -47,6 +48,7 @@   copyByteArray, copyMutableByteArray,   copyByteArrayToPtr, copyMutableByteArrayToPtr,   copyByteArrayToAddr, copyMutableByteArrayToAddr,+  copyPtrToMutableByteArray,   moveByteArray,   setByteArray, fillByteArray,   cloneByteArray, cloneMutableByteArray,@@ -72,26 +74,18 @@ import Data.Word ( Word8 ) import Data.Bits ( (.&.), unsafeShiftR ) import GHC.Show ( intToDigit )-import qualified GHC.Exts as Exts ( IsList(..) )+import qualified GHC.Exts as Exts import GHC.Exts hiding (setByteArray#)  import Data.Typeable ( Typeable ) import Data.Data ( Data(..), mkNoRepType )+import qualified Language.Haskell.TH.Syntax as TH+import qualified Language.Haskell.TH.Lib as TH -#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as SG import qualified Data.Foldable as F-#endif -#if __GLASGOW_HASKELL__ >= 802-import GHC.Exts as Exts (isByteArrayPinned#,isMutableByteArrayPinned#)-#endif--#if __GLASGOW_HASKELL__ >= 804-import GHC.Exts (compareByteArrays#)-#else-import System.IO.Unsafe (unsafeDupablePerformIO)-#endif+import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)  -- | Byte arrays. data ByteArray = ByteArray ByteArray# deriving ( Typeable )@@ -100,6 +94,60 @@ data MutableByteArray s = MutableByteArray (MutableByteArray# s)   deriving ( Typeable ) +-- | Respects array pinnedness for GHC >= 8.2+instance TH.Lift ByteArray where+#if MIN_VERSION_template_haskell(2,17,0)+  liftTyped ba = TH.unsafeCodeCoerce (TH.lift ba)+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped ba = TH.unsafeTExpCoerce (TH.lift ba)+#endif++  lift ba =+    TH.appE+      (if small+         then [| fromLitAddrSmall# pinned len |]+         else [| fromLitAddrLarge# pinned len |])+      (TH.litE (TH.stringPrimL (toList ba)))+    where+      -- Pin it if the original was pinned; otherwise don't. This seems more+      -- logical to me than the alternatives. Anyone who wants a different+      -- pinnedness can just copy the compile-time byte array to one that+      -- matches what they want at run-time.+#if __GLASGOW_HASKELL__ >= 802+      pinned = isByteArrayPinned ba+#else+      pinned = True+#endif+      len = sizeofByteArray ba+      small = len <= 2048++-- I don't think inlining these can be very helpful, so let's not+-- do it.+{-# NOINLINE fromLitAddrSmall# #-}+fromLitAddrSmall# :: Bool -> Int -> Addr# -> ByteArray+fromLitAddrSmall# pinned len ptr = inline (fromLitAddr# True pinned len ptr)++{-# NOINLINE fromLitAddrLarge# #-}+fromLitAddrLarge# :: Bool -> Int -> Addr# -> ByteArray+fromLitAddrLarge# pinned len ptr = inline (fromLitAddr# False pinned len ptr)++fromLitAddr# :: Bool -> Bool -> Int -> Addr# -> ByteArray+fromLitAddr# small pinned !len !ptr = upIO $ do+  mba <- if pinned+         then newPinnedByteArray len+         else newByteArray len+  copyPtrToMutableByteArray mba 0 (Ptr ptr :: Ptr Word8) len+  unsafeFreezeByteArray mba+  where+    -- We don't care too much about duplication if the byte arrays are+    -- small. If they're large, we do. Since we don't allocate while+    -- we copy (we do it with a primop!), I don't believe the thunk+    -- deduplication mechanism can help us if two threads just happen+    -- to try to build the ByteArray at the same time.+    upIO+      | small = unsafeDupablePerformIO+      | otherwise = unsafePerformIO+ instance NFData ByteArray where   rnf (ByteArray _) = () @@ -281,18 +329,22 @@  #if __GLASGOW_HASKELL__ >= 802 -- | Check whether or not the byte array is pinned. Pinned byte arrays cannot--- be moved by the garbage collector. It is safe to use 'byteArrayContents'--- on such byte arrays. This function is only available when compiling with--- GHC 8.2 or newer.+-- be moved by the garbage collector. It is safe to use 'byteArrayContents' on+-- such byte arrays. --+-- Caution: This function is only available when compiling with GHC 8.2 or+-- newer.+-- -- @since 0.6.4.0 isByteArrayPinned :: ByteArray -> Bool {-# INLINE isByteArrayPinned #-} isByteArrayPinned (ByteArray arr#) = isTrue# (Exts.isByteArrayPinned# arr#) --- | Check whether or not the mutable byte array is pinned. This function is--- only available when compiling with GHC 8.2 or newer.+-- | Check whether or not the mutable byte array is pinned. --+-- Caution: This function is only available when compiling with GHC 8.2 or+-- newer.+-- -- @since 0.6.4.0 isMutableByteArrayPinned :: MutableByteArray s -> Bool {-# INLINE isMutableByteArrayPinned #-}@@ -413,6 +465,23 @@   where   siz# = sizeOf# (undefined :: a) +-- | Copy from an unmanaged pointer address to a byte array. These must not+-- overlap. The offset and length are given in elements, not in bytes.+--+-- /Note:/ this function does not do bounds or overlap checking.+copyPtrToMutableByteArray :: forall m a. (PrimMonad m, Prim a)+  => MutableByteArray (PrimState m) -- ^ destination array+  -> Int   -- ^ destination offset given in elements of type @a@+  -> Ptr a -- ^ source pointer+  -> Int   -- ^ number of elements+  -> m ()+{-# INLINE copyPtrToMutableByteArray #-}+copyPtrToMutableByteArray (MutableByteArray ba#) (I# doff#) (Ptr addr#) (I# n#) =+  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))+  where+  siz# = sizeOf# (undefined :: a)++ -- | Copy a slice of a mutable byte array to an unmanaged pointer address. -- These must not overlap. The offset and length are given in elements, not -- in bytes.@@ -678,16 +747,13 @@   go 0   unsafeFreezeByteArray marr -#if MIN_VERSION_base(4,9,0) instance SG.Semigroup ByteArray where   (<>) = appendByteArray   sconcat = mconcat . F.toList-  stimes i arr-    | itgr < 1 = emptyByteArray-    | itgr <= fromIntegral (maxBound :: Int) = replicateByteArray (fromIntegral itgr) arr-    | otherwise = error "Data.Primitive.ByteArray#stimes: cannot allocate the requested amount of memory"-    where itgr = toInteger i :: Integer-#endif+  stimes n arr = case compare n 0 of+    LT -> die "stimes" "negative multiplier"+    EQ -> emptyByteArray+    GT -> replicateByteArray (fromIntegral n) arr  instance Monoid ByteArray where   mempty = emptyByteArray
Data/Primitive/MachDeps.hs view
@@ -113,7 +113,7 @@ sIZEOF_WORD64 = SIZEOF_WORD64 aLIGNMENT_WORD64 = ALIGNMENT_WORD64 -#if WORD_SIZE_IN_BITS == 32+#if WORD_SIZE_IN_BITS == 32 || __GLASGOW_HASKELL__ >= 903 type Word64_# = Word64# type Int64_# = Int64# #else
Data/Primitive/PrimArray.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TemplateHaskellQuotes #-}  -- | -- Module      : Data.Primitive.PrimArray@@ -50,6 +51,7 @@   , copyMutablePrimArray   , copyPrimArrayToPtr   , copyMutablePrimArrayToPtr+  , copyPtrToMutablePrimArray   , clonePrimArray   , cloneMutablePrimArray   , setPrimArray@@ -116,11 +118,10 @@ import qualified Data.Primitive.ByteArray as PB import qualified Data.Primitive.Types as PT import qualified GHC.ST as GHCST+import Language.Haskell.TH.Syntax (Lift (..)) -#if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup) import qualified Data.Semigroup as SG-#endif  #if __GLASGOW_HASKELL__ >= 802 import qualified GHC.Exts as Exts@@ -133,6 +134,15 @@ -- which is lazy in its elements. data PrimArray a = PrimArray ByteArray# +instance Lift (PrimArray a) where+#if MIN_VERSION_template_haskell(2,16,0)+  liftTyped ary = [|| byteArrayToPrimArray ba ||]+#else+  lift ary = [| byteArrayToPrimArray ba |]+#endif+    where+      ba = primArrayToByteArray ary+ instance NFData (PrimArray a) where   rnf (PrimArray _) = () @@ -241,13 +251,11 @@ byteArrayToPrimArray :: ByteArray -> PrimArray a byteArrayToPrimArray (PB.ByteArray x) = PrimArray x -#if MIN_VERSION_base(4,9,0) -- | @since 0.6.4.0 instance Semigroup (PrimArray a) where   x <> y = byteArrayToPrimArray (primArrayToByteArray x SG.<> primArrayToByteArray y)   sconcat = byteArrayToPrimArray . SG.sconcat . fmap primArrayToByteArray   stimes i arr = byteArrayToPrimArray (SG.stimes i (primArrayToByteArray arr))-#endif  -- | @since 0.6.4.0 instance Monoid (PrimArray a) where@@ -407,6 +415,24 @@         let s'# = copyMutableByteArrayToAddr# mba# (soff# *# siz#) addr# (n# *# siz#) s#         in (# s'#, () #))   where siz# = sizeOf# (undefined :: a)++-- | Copy from a pointer to a mutable primitive array.+-- The offset and length are given in elements of type @a@.+-- This function assumes that the 'Prim' instance of @a@+-- agrees with the 'Storable' instance.+--+-- /Note:/ this function does not do bounds or overlap checking.+copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)+  => MutablePrimArray (PrimState m) a -- ^ destination array+  -> Int -- ^ destination offset+  -> Ptr a -- ^ source pointer+  -> Int -- ^ number of elements+  -> m ()+{-# INLINE copyPtrToMutablePrimArray #-}+copyPtrToMutablePrimArray (MutablePrimArray ba#) (I# doff#) (Ptr addr#) (I# n#) =+  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))+  where+  siz# = sizeOf# (undefined :: a)  -- | Fill a slice of a mutable primitive array with a value. --
Data/Primitive/Ptr.hs view
@@ -28,16 +28,14 @@   -- * Block operations   copyPtr, movePtr, setPtr -#if __GLASGOW_HASKELL__ >= 708   , copyPtrToMutablePrimArray   , copyPtrToMutableByteArray-#endif ) where  import Control.Monad.Primitive import Data.Primitive.Types-import Data.Primitive.PrimArray (MutablePrimArray(..))-import Data.Primitive.ByteArray (MutableByteArray(..))+import Data.Primitive.PrimArray (copyPtrToMutablePrimArray)+import Data.Primitive.ByteArray (copyPtrToMutableByteArray)  import GHC.Exts import GHC.Ptr@@ -102,32 +100,3 @@ setPtr :: (Prim a, PrimMonad m) => Ptr a -> Int -> a -> m () {-# INLINE setPtr #-} setPtr (Ptr addr#) (I# n#) x = primitive_ (setOffAddr# addr# 0# n# x)----- | Copy from a pointer to a mutable primitive array.--- The offset and length are given in elements of type @a@.-copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)-  => MutablePrimArray (PrimState m) a -- ^ destination array-  -> Int -- ^ destination offset-  -> Ptr a -- ^ source pointer-  -> Int -- ^ number of elements-  -> m ()-{-# INLINE copyPtrToMutablePrimArray #-}-copyPtrToMutablePrimArray (MutablePrimArray ba#) (I# doff#) (Ptr addr#) (I# n#) =-  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))-  where-  siz# = sizeOf# (undefined :: a)---- | Copy from a pointer to a mutable byte array.--- The offset and length are given in elements of type @a@.-copyPtrToMutableByteArray :: forall m a. (PrimMonad m, Prim a)-  => MutableByteArray (PrimState m) -- ^ destination array-  -> Int   -- ^ destination offset given in elements of type @a@-  -> Ptr a -- ^ source pointer-  -> Int   -- ^ number of elements-  -> m ()-{-# INLINE copyPtrToMutableByteArray #-}-copyPtrToMutableByteArray (MutableByteArray ba#) (I# doff#) (Ptr addr#) (I# n#) =-  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))-  where-  siz# = sizeOf# (undefined :: a)
Data/Primitive/SmallArray.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TemplateHaskellQuotes #-}  -- | -- Module : Data.Primitive.SmallArray@@ -81,18 +82,15 @@ #if !(MIN_VERSION_base(4,10,0)) import Data.Monoid #endif-#if MIN_VERSION_base(4,9,0) import qualified GHC.ST as GHCST import qualified Data.Semigroup as Sem-#endif import Text.ParserCombinators.ReadP-#if MIN_VERSION_base(4,10,0)-import GHC.Exts (runRW#)-#elif MIN_VERSION_base(4,9,0)+#if !MIN_VERSION_base(4,10,0) import GHC.Base (runRW#) #endif  import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))+import Language.Haskell.TH.Syntax (Lift(..))  data SmallArray a = SmallArray (SmallArray# a)   deriving Typeable@@ -108,6 +106,36 @@ data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)   deriving Typeable +instance Lift a => Lift (SmallArray a) where+#if MIN_VERSION_template_haskell(2,16,0)+  liftTyped ary = case lst of+    [] -> [|| SmallArray (emptySmallArray# (##)) ||]+    [x] -> [|| pure $! x ||]+    x : xs -> [|| unsafeSmallArrayFromListN' len x xs ||]+#else+  lift ary = case lst of+    [] -> [| SmallArray (emptySmallArray# (##)) |]+    [x] -> [| pure $! x |]+    x : xs -> [| unsafeSmallArrayFromListN' len x xs |]+#endif+    where+      len = length ary+      lst = toList ary++-- | Strictly create an array from a nonempty list (represented as+-- a first element and a list of the rest) of a known length. If the length+-- of the list does not match the given length, this makes demons fly+-- out of your nose. We use it in the 'Lift' instance. If you edit the+-- splice and break it, you get to keep both pieces.+unsafeSmallArrayFromListN' :: Int -> a -> [a] -> SmallArray a+unsafeSmallArrayFromListN' n y ys =+  createSmallArray n y $ \sma ->+    let go !_ix [] = return ()+        go !ix (!x : xs) = do+            writeSmallArray sma ix x+            go (ix+1) xs+    in go 1 ys+ -- | Create a new small mutable array. -- -- /Note:/ this function does not check if the input is non-negative.@@ -371,9 +399,6 @@ runSmallArray   :: (forall s. ST s (SmallMutableArray s a))   -> SmallArray a-#if !MIN_VERSION_base(4,9,0)-runSmallArray m = runST $ m >>= unsafeFreezeSmallArray-#else -- This low-level business is designed to work with GHC's worker-wrapper -- transformation. A lot of the time, we don't actually need an Array -- constructor. By putting it on the outside, and being careful about@@ -392,7 +417,6 @@  unST :: ST s a -> State# s -> (# State# s, a #) unST (GHCST.ST f) = f-#endif  -- | Create an array of the given size with a default value, -- apply the monadic function and freeze the result. If the@@ -450,11 +474,7 @@  -- | @since 0.6.4.0 instance Eq1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftEq = smallArrayLiftEq-#else-  eq1 = smallArrayLiftEq (==)-#endif  instance Eq a => Eq (SmallArray a) where   sa1 == sa2 = smallArrayLiftEq (==) sa1 sa2@@ -476,11 +496,7 @@  -- | @since 0.6.4.0 instance Ord1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftCompare = smallArrayLiftCompare-#else-  compare1 = smallArrayLiftCompare compare-#endif  -- | Lexicographic ordering. Subject to change between major versions. instance Ord a => Ord (SmallArray a) where@@ -762,12 +778,21 @@       sz = sizeofSmallArray (f err)       err = error "mfix for Data.Primitive.SmallArray applied to strict function." -#if MIN_VERSION_base(4,9,0) -- | @since 0.6.3.0 instance Sem.Semigroup (SmallArray a) where   (<>) = (<|>)   sconcat = mconcat . toList-#endif+  stimes n arr = case compare n 0 of+    LT -> die "stimes" "negative multiplier"+    EQ -> empty+    GT -> createSmallArray (n' * sizeofSmallArray arr) (die "stimes" "impossible") $ \sma ->+      let go i = if i < n'+            then do+              copySmallArray sma (i * sizeofSmallArray arr) arr 0 (sizeofSmallArray arr)+              go (i + 1)+            else return ()+      in go 0+    where n' = fromIntegral n :: Int  instance Monoid (SmallArray a) where   mempty = empty@@ -801,11 +826,7 @@  -- | @since 0.6.4.0 instance Show1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftShowsPrec = smallArrayLiftShowsPrec-#else-  showsPrec1 = smallArrayLiftShowsPrec showsPrec showList-#endif  smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a) smallArrayLiftReadsPrec _ listReadsPrec p = readParen (p > 10) . readP_to_S $ do@@ -821,11 +842,7 @@  -- | @since 0.6.4.0 instance Read1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftReadsPrec = smallArrayLiftReadsPrec-#else-  readsPrec1 = smallArrayLiftReadsPrec readsPrec readList-#endif
Data/Primitive/Types.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}-#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-} {-# LANGUAGE DeriveGeneric #-}-#endif  #include "HsBaseConfig.h" @@ -52,9 +50,7 @@ import Data.Functor.Identity (Identity(..)) import qualified Data.Monoid as Monoid import Data.Ord (Down(..))-#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Semigroup-#endif  -- | Class of types supporting primitive array operations. This includes -- interfacing with GC-managed memory (functions suffixed with @ByteArray#@)@@ -444,7 +440,6 @@ deriving instance Prim a => Prim (Monoid.Sum a) -- | @since 0.6.5.0 deriving instance Prim a => Prim (Monoid.Product a)-#if MIN_VERSION_base(4,9,0) -- | @since 0.6.5.0 deriving instance Prim a => Prim (Semigroup.First a) -- | @since 0.6.5.0@@ -453,4 +448,3 @@ deriving instance Prim a => Prim (Semigroup.Min a) -- | @since 0.6.5.0 deriving instance Prim a => Prim (Semigroup.Max a)-#endif
changelog.md view
@@ -1,3 +1,17 @@+## Changes in version 0.7.4.0++  * Add Lift instances (#332)++  * Expose `copyPtrToMutablePrimArray`++  * Improve definitions for stimes (#326)++  * Support GHC 9.4. Note: GHC 9.4 is not released at the time of+    primitive-0.7.4.0's release, so this support might be reverted by+    a hackage metadata revision if things change.++  * Drop support for GHC 7.10+ ## Changes in version 0.7.3.0    * Correct implementations of `*>` for `Array` and `SmallArray`.
primitive.cabal view
@@ -1,7 +1,7 @@-Cabal-Version:  2.2+Cabal-Version:  2.0 Name:           primitive-Version:        0.7.3.0-License:        BSD-3-Clause+Version:        0.7.4.0+License:        BSD3 License-File:   LICENSE  Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -19,7 +19,6 @@                     test/LICENSE  Tested-With:-  GHC == 7.10.3,   GHC == 8.0.2,   GHC == 8.2.2,   GHC == 8.4.4,@@ -49,11 +48,10 @@   Other-Modules:         Data.Primitive.Internal.Operations -  Build-Depends: base >= 4.8 && < 4.17+  Build-Depends: base >= 4.9 && < 4.18                , deepseq >= 1.1 && < 1.5-               , transformers >= 0.4.2 && < 0.7-  if !impl(ghc >= 8.0)-    Build-Depends: fail == 4.9.*+               , transformers >= 0.5 && < 0.7+               , template-haskell >= 2.11    Ghc-Options: -O2 @@ -82,10 +80,8 @@                , tasty ^>= 1.2 || ^>= 1.3 || ^>= 1.4                , tasty-quickcheck                , tagged-               , transformers >= 0.4+               , transformers >= 0.5                , transformers-compat-  if !impl(ghc >= 8.0)-    build-depends: semigroups    cpp-options: -DHAVE_UNARY_LAWS   ghc-options: -O2@@ -107,7 +103,7 @@     , primitive     , deepseq     , tasty-bench-    , transformers >= 0.3+    , transformers >= 0.5  source-repository head   type:     git
test/main.hs view
@@ -31,10 +31,8 @@ import Data.Functor.Identity (Identity(..)) import qualified Data.Monoid as Monoid import Data.Ord (Down(..))-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (stimes)+import Data.Semigroup (stimes, stimesMonoid) import qualified Data.Semigroup as Semigroup-#endif #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif@@ -70,6 +68,8 @@       , TQC.testProperty "mapArray'" (QCCL.mapProp int16 int32 mapArray')       , TQC.testProperty "*>" $ \(xs :: Array Int) (ys :: Array Int) -> toList (xs *> ys) === (toList xs *> toList ys)       , TQC.testProperty "<*" $ \(xs :: Array Int) (ys :: Array Int) -> toList (xs <* ys) === (toList xs <* toList ys)+      , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (Array Int)))+      , TQC.testProperty "stimes" $ \(QC.NonNegative (n :: Int)) (xs :: Array Int) -> stimes n xs == stimesMonoid n xs       ]     , testGroup "SmallArray"       [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (SmallArray Int)))@@ -85,6 +85,8 @@       , TQC.testProperty "mapSmallArray'" (QCCL.mapProp int16 int32 mapSmallArray')       , TQC.testProperty "*>" $ \(xs :: SmallArray Int) (ys :: SmallArray Int) -> toList (xs *> ys) === (toList xs *> toList ys)       , TQC.testProperty "<*" $ \(xs :: SmallArray Int) (ys :: SmallArray Int) -> toList (xs <* ys) === (toList xs <* toList ys)+      , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (SmallArray Int)))+      , TQC.testProperty "stimes" $ \(QC.NonNegative (n :: Int)) (xs :: SmallArray Int) -> stimes n xs == stimesMonoid n xs       ]     , testGroup "ByteArray"       [ testGroup "Ordering"@@ -109,9 +111,12 @@         ]       , lawsToTest (QCC.eqLaws (Proxy :: Proxy ByteArray))       , lawsToTest (QCC.ordLaws (Proxy :: Proxy ByteArray))+      , lawsToTest (QCC.monoidLaws (Proxy :: Proxy ByteArray))       , lawsToTest (QCC.showReadLaws (Proxy :: Proxy (Array Int)))       , lawsToTest (QCC.isListLaws (Proxy :: Proxy ByteArray))       , TQC.testProperty "foldrByteArray" (QCCL.foldrProp word8 foldrByteArray)+      , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy ByteArray))+      , TQC.testProperty "stimes" $ \(QC.NonNegative (n :: Int)) (xs :: ByteArray) -> stimes n xs == stimesMonoid n xs       ]     , testGroup "PrimArray"       [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (PrimArray Word16)))@@ -141,6 +146,8 @@       , TQC.testProperty "mapMaybePrimArray" (QCCL.mapMaybeProp int16 int32 mapMaybePrimArray)       , TQC.testProperty "mapMaybePrimArrayA" (QCCL.mapMaybeMProp int16 int32 mapMaybePrimArrayA)       , TQC.testProperty "mapMaybePrimArrayP" (QCCL.mapMaybeMProp int16 int32 mapMaybePrimArrayP)+      , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (PrimArray Word16)))+      , TQC.testProperty "stimes" $ \(QC.NonNegative (n :: Int)) (xs :: PrimArray Word16) -> stimes n xs == stimesMonoid n xs       ]     , testGroup "DefaultSetMethod"       [ lawsToTest (primLaws (Proxy :: Proxy DefaultSetMethod))@@ -167,24 +174,20 @@       , renameLawsToTest "Dual" (primLaws (Proxy :: Proxy (Monoid.Dual Int16)))       , renameLawsToTest "Sum" (primLaws (Proxy :: Proxy (Monoid.Sum Int16)))       , renameLawsToTest "Product" (primLaws (Proxy :: Proxy (Monoid.Product Int16)))-#if MIN_VERSION_base(4,9,0)       , renameLawsToTest "First" (primLaws (Proxy :: Proxy (Semigroup.First Int16)))       , renameLawsToTest "Last" (primLaws (Proxy :: Proxy (Semigroup.Last Int16)))       , renameLawsToTest "Min" (primLaws (Proxy :: Proxy (Semigroup.Min Int16)))       , renameLawsToTest "Max" (primLaws (Proxy :: Proxy (Semigroup.Max Int16)))-#endif       ]     ]  deriving instance Arbitrary a => Arbitrary (Down a) -- Const, Dual, Sum, Product: all have Arbitrary instances defined -- in QuickCheck itself-#if MIN_VERSION_base(4,9,0) deriving instance Arbitrary a => Arbitrary (Semigroup.First a) deriving instance Arbitrary a => Arbitrary (Semigroup.Last a) deriving instance Arbitrary a => Arbitrary (Semigroup.Min a) deriving instance Arbitrary a => Arbitrary (Semigroup.Max a)-#endif  word8 :: Proxy Word8 word8 = Proxy@@ -354,10 +357,8 @@         fail $ "ByteArray Monoid mappend not associative"     unless (mconcat [arr1,arr2,arr3,arr4,arr5] == (arr1 <> arr2 <> arr3 <> arr4 <> arr5)) $         fail $ "ByteArray Monoid mconcat incorrect"-#if MIN_VERSION_base(4,9,0)     unless (stimes (3 :: Int) arr4 == (arr4 <> arr4 <> arr4)) $         fail $ "ByteArray Semigroup stimes incorrect"-#endif  mkByteArray :: Prim a => [a] -> ByteArray mkByteArray xs = runST $ do