Hello community, here is the log from the commit of package ghc-primitive for openSUSE:Factory checked in at 2018-05-30 12:11:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-primitive (Old) and /work/SRC/openSUSE:Factory/.ghc-primitive.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-primitive" Wed May 30 12:11:44 2018 rev:13 rq:607860 version:0.6.3.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-primitive/ghc-primitive.changes 2017-09-15 22:06:44.107194058 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-primitive.new/ghc-primitive.changes 2018-05-30 12:26:51.387209808 +0200 @@ -1,0 +2,13 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update primitive to version 0.6.3.0. + + * Add `PrimMonad` instances for `ContT`, `AccumT`, and `SelectT` from + `transformers` + + * Add `Eq`, `Ord`, `Show`, and `IsList` instances for `ByteArray` + + * Add `Semigroup` instances for `Array` and `SmallArray`. This allows + `primitive` to build on GHC 8.4 and later. + +------------------------------------------------------------------- Old: ---- primitive-0.6.2.0.tar.gz primitive.cabal New: ---- primitive-0.6.3.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-primitive.spec ++++++ --- /var/tmp/diff_new_pack.CKAuVS/_old 2018-05-30 12:26:51.951190468 +0200 +++ /var/tmp/diff_new_pack.CKAuVS/_new 2018-05-30 12:26:51.955190330 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-primitive # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,14 +18,13 @@ %global pkg_name primitive Name: ghc-%{pkg_name} -Version: 0.6.2.0 +Version: 0.6.3.0 Release: 0 Summary: Primitive memory-related operations License: BSD-3-Clause Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel @@ -46,7 +45,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build @@ -61,7 +59,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files %doc changelog.md ++++++ primitive-0.6.2.0.tar.gz -> primitive-0.6.3.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Control/Monad/Primitive.hs new/primitive-0.6.3.0/Control/Monad/Primitive.hs --- old/primitive-0.6.2.0/Control/Monad/Primitive.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Control/Monad/Primitive.hs 2018-01-22 03:17:19.000000000 +0100 @@ -41,6 +41,7 @@ import Data.Monoid (Monoid) #endif +import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Trans.Identity ( IdentityT (IdentityT) ) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) @@ -54,6 +55,11 @@ import Control.Monad.Trans.Except ( ExceptT ) #endif +#if MIN_VERSION_transformers(0,5,3) +import Control.Monad.Trans.Accum ( AccumT ) +import Control.Monad.Trans.Select ( SelectT ) +#endif + import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) @@ -91,6 +97,10 @@ internal (IO p) = p {-# INLINE internal #-} +instance PrimMonad m => PrimMonad (ContT r m) where + type PrimState (ContT r m) = PrimState m + primitive = lift . primitive + {-# INLINE primitive #-} instance PrimMonad m => PrimMonad (IdentityT m) where type PrimState (IdentityT m) = PrimState m primitive = lift . primitive @@ -133,6 +143,22 @@ primitive = lift . primitive {-# INLINE primitive #-} #endif + +#if MIN_VERSION_transformers(0,5,3) +instance ( Monoid w + , PrimMonad m +# if !(MIN_VERSION_base(4,8,0)) + , Functor m +# endif + ) => PrimMonad (AccumT w m) where + type PrimState (AccumT w m) = PrimState m + primitive = lift . primitive + {-# INLINE primitive #-} +instance PrimMonad m => PrimMonad (SelectT r m) where + type PrimState (SelectT r m) = PrimState m + primitive = lift . primitive + {-# INLINE primitive #-} +#endif instance PrimMonad m => PrimMonad (Strict.StateT s m) where type PrimState (Strict.StateT s m) = PrimState m diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Data/Primitive/Array.hs new/primitive-0.6.3.0/Data/Primitive/Array.hs --- old/primitive-0.6.2.0/Data/Primitive/Array.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Data/Primitive/Array.hs 2018-01-22 03:17:19.000000000 +0100 @@ -52,6 +52,10 @@ import Data.Traversable (Traversable(..)) import Data.Monoid #endif +#if MIN_VERSION_base(4,9,0) +import qualified Data.Foldable as F +import Data.Semigroup +#endif import Text.ParserCombinators.ReadP @@ -272,7 +276,7 @@ -> Array a {-# INLINE cloneArray #-} #if __GLASGOW_HASKELL__ >= 702 -cloneArray (Array arr#) (I# off#) (I# len#) +cloneArray (Array arr#) (I# off#) (I# len#) = case cloneArray# arr# off# len# of arr'# -> Array arr'# #else cloneArray arr off len = runST $ do @@ -528,9 +532,17 @@ instance MonadFix Array where mfix f = let l = mfix (toList . f) in fromListN (length l) l +#if MIN_VERSION_base(4,9,0) +instance Semigroup (Array a) where + (<>) = (<|>) + sconcat = mconcat . F.toList +#endif + instance Monoid (Array a) where mempty = empty +#if !(MIN_VERSION_base(4,11,0)) mappend = (<|>) +#endif mconcat l = createArray sz (die "mconcat" "impossible") $ \ma -> let go !_ [ ] = return () go off (a:as) = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Data/Primitive/ByteArray.hs new/primitive-0.6.3.0/Data/Primitive/ByteArray.hs --- old/primitive-0.6.2.0/Data/Primitive/ByteArray.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Data/Primitive/ByteArray.hs 2018-01-22 03:17:19.000000000 +0100 @@ -1,4 +1,6 @@ {-# LANGUAGE CPP, MagicHash, UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.Primitive.ByteArray @@ -21,6 +23,9 @@ -- * Element access readByteArray, writeByteArray, indexByteArray, + -- * Folding + foldrByteArray, + -- * Freezing and thawing unsafeFreezeByteArray, unsafeThawByteArray, @@ -34,11 +39,16 @@ ) where import Control.Monad.Primitive +import Control.Monad.ST +import Control.Monad ( zipWithM_ ) import Data.Primitive.Types import Foreign.C.Types import Data.Word ( Word8 ) import GHC.Base ( Int(..) ) +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts ( IsList(..) ) +#endif import GHC.Prim #if __GLASGOW_HASKELL__ >= 706 hiding (setByteArray#) @@ -47,6 +57,8 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) +import Numeric +import System.IO.Unsafe -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) @@ -55,23 +67,23 @@ data MutableByteArray s = MutableByteArray (MutableByteArray# s) deriving( Typeable ) --- | Create a new mutable byte array of the specified size. +-- | Create a new mutable byte array of the specified size in bytes. newByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) {-# INLINE newByteArray #-} newByteArray (I# n#) = primitive (\s# -> case newByteArray# n# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) --- | Create a /pinned/ byte array of the specified size. The garbage collector --- is guaranteed not to move it. +-- | Create a /pinned/ byte array of the specified size in bytes. The garbage +-- collector is guaranteed not to move it. newPinnedByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) {-# INLINE newPinnedByteArray #-} newPinnedByteArray (I# n#) = primitive (\s# -> case newPinnedByteArray# n# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) --- | Create a /pinned/ byte array of the specified size and with the give --- alignment. The garbage collector is guaranteed not to move it. +-- | Create a /pinned/ byte array of the specified size in bytes and with the +-- give alignment. The garbage collector is guaranteed not to move it. newAlignedPinnedByteArray :: PrimMonad m => Int -> Int -> m (MutableByteArray (PrimState m)) {-# INLINE newAlignedPinnedByteArray #-} @@ -117,12 +129,12 @@ unsafeThawByteArray (ByteArray arr#) = primitive (\s# -> (# s#, MutableByteArray (unsafeCoerce# arr#) #)) --- | Size of the byte array. +-- | Size of the byte array in bytes. sizeofByteArray :: ByteArray -> Int {-# INLINE sizeofByteArray #-} sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#) --- | Size of the mutable byte array. +-- | Size of the mutable byte array in bytes. sizeofMutableByteArray :: MutableByteArray s -> Int {-# INLINE sizeofMutableByteArray #-} sizeofMutableByteArray (MutableByteArray arr#) = I# (sizeofMutableByteArray# arr#) @@ -149,6 +161,21 @@ writeByteArray (MutableByteArray arr#) (I# i#) x = primitive_ (writeByteArray# arr# i# x) +-- | Right-fold over the elements of a 'ByteArray'. +foldrByteArray :: forall a b. (Prim a) => (a -> b -> b) -> b -> ByteArray -> b +foldrByteArray f z arr = go 0 + where + go i + | sizeofByteArray arr > i * sz = f (indexByteArray arr i) (go (i+1)) + | otherwise = z + sz = sizeofByteArray arr + +fromListN :: Prim a => Int -> [a] -> ByteArray +fromListN n xs = runST $ do + marr <- newByteArray (n * sizeOf (head xs)) + zipWithM_ (writeByteArray marr) [0..n] xs + unsafeFreezeByteArray marr + #if __GLASGOW_HASKELL__ >= 702 unI# :: Int -> Int# unI# (I# n#) = n# @@ -262,3 +289,58 @@ toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" + +instance Show ByteArray where + showsPrec _ ba = + showString "[" . go 0 + where + go i + | i < sizeofByteArray ba = comma . showString "0x" . showHex (indexByteArray ba i :: Word8) . go (i+1) + | otherwise = showChar ']' + where + comma | i == 0 = id + | otherwise = showString ", " + +foreign import ccall unsafe "primitive-memops.h hsprimitive_memcmp" + memcmp_ba :: ByteArray# -> ByteArray# -> CSize -> IO CInt + +sameByteArray :: ByteArray# -> ByteArray# -> Bool +sameByteArray ba1 ba2 = + case reallyUnsafePtrEquality# (unsafeCoerce# ba1 :: ()) (unsafeCoerce# ba2 :: ()) of +#if __GLASGOW_HASKELL__ >= 708 + r -> isTrue# r +#else + 1# -> True + 0# -> False +#endif + +instance Eq ByteArray where + ba1@(ByteArray ba1#) == ba2@(ByteArray ba2#) + | sameByteArray ba1# ba2# = True + | sizeofByteArray ba1 /= sizeofByteArray ba2 = False + | otherwise = + case unsafeDupablePerformIO $ memcmp_ba ba1# ba2# (fromIntegral $ sizeofByteArray ba1) of + 0 -> True + _ -> False + +instance Ord ByteArray where + ba1@(ByteArray ba1#) `compare` ba2@(ByteArray ba2#) + | sameByteArray ba1# ba2# = EQ + | n1 /= n2 = n1 `compare` n2 + | otherwise = + case unsafeDupablePerformIO $ memcmp_ba ba1# ba2# (fromIntegral n1) of + x | x > 0 -> GT + | x == 0 -> EQ + | otherwise -> LT + where + n1 = sizeofByteArray ba1 + n2 = sizeofByteArray ba2 + +#if __GLASGOW_HASKELL__ >= 708 +instance Exts.IsList ByteArray where + type Item ByteArray = Word8 + + toList = foldrByteArray (:) [] + fromList xs = fromListN (length xs) xs + fromListN = fromListN +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Data/Primitive/SmallArray.hs new/primitive-0.6.3.0/Data/Primitive/SmallArray.hs --- old/primitive-0.6.2.0/Data/Primitive/SmallArray.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Data/Primitive/SmallArray.hs 2018-01-22 03:17:19.000000000 +0100 @@ -77,6 +77,9 @@ import Data.Foldable import Data.Functor.Identity import Data.Monoid +#if MIN_VERSION_base(4,9,0) +import qualified Data.Semigroup as Sem +#endif import Text.ParserCombinators.ReadPrec import Text.Read import Text.Read.Lex @@ -575,9 +578,17 @@ instance MonadFix SmallArray where mfix f = fromList . mfix $ toList . f +#if MIN_VERSION_base(4,9,0) +instance Sem.Semigroup (SmallArray a) where + (<>) = (<|>) + sconcat = mconcat . toList +#endif + instance Monoid (SmallArray a) where mempty = empty +#if !(MIN_VERSION_base(4,11,0)) mappend = (<|>) +#endif mconcat sas = createSmallArray n (die "mconcat" "impossible") $ \sma -> fix ? 0 ? sas $ \go off l -> case l of [] -> return () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Data/Primitive/Types.hs new/primitive-0.6.3.0/Data/Primitive/Types.hs --- old/primitive-0.6.2.0/Data/Primitive/Types.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Data/Primitive/Types.hs 2018-01-22 03:17:19.000000000 +0100 @@ -13,6 +13,7 @@ module Data.Primitive.Types ( Prim(..), + sizeOf, alignment, Addr(..), ) where @@ -108,6 +109,14 @@ -- The offset and length are in elements of type @a@ rather than in bytes. setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s +-- | Size of values of type @a@. The argument is not used. +sizeOf :: Prim a => a -> Int +sizeOf x = I# (sizeOf# x) + +-- | Alignment of values of type @a@. The argument is not used. +alignment :: Prim a => a -> Int +alignment x = I# (alignment# x) + #define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \ instance Prim (ty) where { \ sizeOf# _ = unI# sz \ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/Data/Primitive.hs new/primitive-0.6.3.0/Data/Primitive.hs --- old/primitive-0.6.2.0/Data/Primitive.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/Data/Primitive.hs 2018-01-22 03:17:19.000000000 +0100 @@ -23,14 +23,3 @@ import Data.Primitive.Array import Data.Primitive.ByteArray import Data.Primitive.Addr - -import GHC.Base ( Int(..) ) - --- | Size of values of type @a@. The argument is not used. -sizeOf :: Prim a => a -> Int -sizeOf x = I# (sizeOf# x) - --- | Alignment of values of type @a@. The argument is not used. -alignment :: Prim a => a -> Int -alignment x = I# (alignment# x) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/cbits/primitive-memops.c new/primitive-0.6.3.0/cbits/primitive-memops.c --- old/primitive-0.6.2.0/cbits/primitive-memops.c 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/cbits/primitive-memops.c 2018-01-22 03:17:19.000000000 +0100 @@ -35,6 +35,11 @@ } \ } +int hsprimitive_memcmp( HsWord8 *s1, HsWord8 *s2, size_t n ) +{ + return memcmp( s1, s2, n ); +} + void hsprimitive_memset_Word8 (HsWord8 *p, ptrdiff_t off, size_t n, HsWord x) { memset( (char *)(p+off), x, n ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/cbits/primitive-memops.h new/primitive-0.6.3.0/cbits/primitive-memops.h --- old/primitive-0.6.2.0/cbits/primitive-memops.h 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/cbits/primitive-memops.h 2018-01-22 03:17:19.000000000 +0100 @@ -7,6 +7,7 @@ void hsprimitive_memcpy( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); +int hsprimitive_memcmp( HsWord8 *s1, HsWord8 *s2, size_t n ); void hsprimitive_memset_Word8 (HsWord8 *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Word16 (HsWord16 *, ptrdiff_t, size_t, HsWord); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/changelog.md new/primitive-0.6.3.0/changelog.md --- old/primitive-0.6.2.0/changelog.md 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/changelog.md 2018-01-22 03:17:19.000000000 +0100 @@ -1,3 +1,13 @@ +## Changes in version 0.6.3.0 + + * Add `PrimMonad` instances for `ContT`, `AccumT`, and `SelectT` from + `transformers` + + * Add `Eq`, `Ord`, `Show`, and `IsList` instances for `ByteArray` + + * Add `Semigroup` instances for `Array` and `SmallArray`. This allows + `primitive` to build on GHC 8.4 and later. + ## Changes in version 0.6.2.0 * Drop support for GHCs before 7.4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/primitive.cabal new/primitive-0.6.3.0/primitive.cabal --- old/primitive-0.6.2.0/primitive.cabal 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/primitive.cabal 2018-01-22 03:17:19.000000000 +0100 @@ -1,5 +1,5 @@ Name: primitive -Version: 0.6.2.0 +Version: 0.6.3.0 License: BSD3 License-File: LICENSE @@ -21,7 +21,9 @@ GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, - GHC == 8.0.1 + GHC == 8.0.2, + GHC == 8.2.2, + GHC == 8.4.1 Library Default-Language: Haskell2010 @@ -45,7 +47,7 @@ Data.Primitive.Internal.Compat Data.Primitive.Internal.Operations - Build-Depends: base >= 4.5 && < 4.10 + Build-Depends: base >= 4.5 && < 4.12 , ghc-prim >= 0.2 && < 0.6 , transformers >= 0.2 && < 0.6 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.6.2.0/test/main.hs new/primitive-0.6.3.0/test/main.hs --- old/primitive-0.6.2.0/test/main.hs 2016-11-21 03:18:50.000000000 +0100 +++ new/primitive-0.6.3.0/test/main.hs 2018-01-22 03:17:19.000000000 +0100 @@ -1,15 +1,28 @@ {-# LANGUAGE MagicHash, UnboxedTuples #-} + +import Control.Monad import Control.Monad.Primitive +import Control.Monad.ST +import Data.Primitive import Data.Primitive.Array +import Data.Primitive.ByteArray +import Data.Primitive.Types +import Data.Word +import GHC.Int import GHC.IO import GHC.Prim --- Since we only have a single test case right now, I'm going to avoid the +-- Since we only have two test cases right now, I'm going to avoid the -- issue of choosing a test framework for the moment. This also keeps the -- package as a whole light on dependencies. main :: IO () main = do + testArray + testByteArray + +testArray :: IO () +testArray = do arr <- newArray 1 'A' let unit = case writeArray arr 0 'B' of @@ -22,3 +35,21 @@ if c1 == 'A' && c2 == 'B' then return () else error $ "Expected AB, got: " ++ show (c1, c2) + +testByteArray :: IO () +testByteArray = do + let arr1 = mkByteArray ([0xde, 0xad, 0xbe, 0xef] :: [Word8]) + arr2 = mkByteArray ([0xde, 0xad, 0xbe, 0xef] :: [Word8]) + arr3 = mkByteArray ([0xde, 0xad, 0xbe, 0xee] :: [Word8]) + when (show arr1 /= "[0xde, 0xad, 0xbe, 0xef]") $ + fail $ "ByteArray Show incorrect: "++show arr1 + unless (arr1 > arr3) $ + fail $ "ByteArray Ord incorrect" + unless (arr1 == arr2) $ + fail $ "ByteArray Eq incorrect" + +mkByteArray :: Prim a => [a] -> ByteArray +mkByteArray xs = runST $ do + marr <- newByteArray (length xs * sizeOf (head xs)) + sequence $ zipWith (writeByteArray marr) [0..] xs + unsafeFreezeByteArray marr
