Hello community, here is the log from the commit of package ghc-primitive for openSUSE:Factory checked in at 2014-11-26 20:54:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-primitive (Old) and /work/SRC/openSUSE:Factory/.ghc-primitive.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-primitive" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-primitive/ghc-primitive.changes 2014-08-25 11:06:00.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-primitive.new/ghc-primitive.changes 2014-11-26 20:55:02.000000000 +0100 @@ -1,0 +2,6 @@ +Tue Sep 2 09:49:34 UTC 2014 - peter.trommler@ohm-hochschule.de + +- update to 0.5.2.1 for Haskell Platform 2014.2.0.0 +- regenerate spec file + +------------------------------------------------------------------- Old: ---- primitive-0.5.0.1.tar.gz New: ---- primitive-0.5.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-primitive.spec ++++++ --- /var/tmp/diff_new_pack.RABGxM/_old 2014-11-26 20:55:04.000000000 +0100 +++ /var/tmp/diff_new_pack.RABGxM/_new 2014-11-26 20:55:04.000000000 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-primitive # -# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2014 SUSE LINUX Products 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,39 +18,36 @@ %global pkg_name primitive -%global common_summary Haskell wrappers for primitive operations - -%global common_description This package provides wrappers for primitive array operations from GHC.Prim. - Name: ghc-primitive -Version: 0.5.0.1 +Version: 0.5.2.1 Release: 0 -Summary: %{common_summary} +Summary: Primitive memory-related operations License: BSD-3-Clause Group: System/Libraries -BuildRoot: %{_tmppath}/%{name}-%{version}-build -# BEGIN cabal2spec Url: http://hackage.haskell.org/package/%{pkg_name} Source0: http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz +BuildRoot: %{_tmppath}/%{name}-%{version}-build + BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros -# END cabal2spec %description -%{common_description} +This package provides various primitive memory-related operations. + %package devel Summary: Haskell %{pkg_name} library development files -Group: Development/Languages/Other -Requires: ghc-compiler -Requires(post): ghc-compiler -Requires(postun): ghc-compiler +Group: Development/Libraries/Other +Provides: %{name}-static = %{version}-%{release} +Requires: ghc-compiler = %{ghc_version} +Requires(post): ghc-compiler = %{ghc_version} +Requires(postun): ghc-compiler = %{ghc_version} Requires: %{name} = %{version}-%{release} %description devel -%{common_description} -This package contains the development files. +This package provides the Haskell %{pkg_name} library development files. + %prep %setup -q -n %{pkg_name}-%{version} ++++++ primitive-0.5.0.1.tar.gz -> primitive-0.5.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Control/Monad/Primitive.hs new/primitive-0.5.2.1/Control/Monad/Primitive.hs --- old/primitive-0.5.0.1/Control/Monad/Primitive.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Control/Monad/Primitive.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies #-} +{-# LANGUAGE CPP, MagicHash, UnboxedTuples, TypeFamilies #-} -- | -- Module : Control.Monad.Primitive @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Primitive state-transformer monads -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/Addr.hs new/primitive-0.5.2.1/Data/Primitive/Addr.hs --- old/primitive-0.5.0.1/Data/Primitive/Addr.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/Addr.hs 2014-02-19 20:25:03.000000000 +0100 @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Primitive operations on machine addresses -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/Array.hs new/primitive-0.5.2.1/Data/Primitive/Array.hs --- old/primitive-0.5.0.1/Data/Primitive/Array.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/Array.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} +{-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} -- | -- Module : Data.Primitive.Array @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Primitive boxed arrays -- @@ -26,7 +26,7 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable ) @@ -81,7 +81,7 @@ -- Now, indexing is executed immediately although the returned element is -- still not evaluated. -- -indexArrayM :: Monad m => Array a -> Int -> m a +indexArrayM :: Monad m => Array a -> Int -> m a {-# INLINE indexArrayM #-} indexArrayM (Array arr#) (I# i#) = case indexArray# arr# i# of (# x #) -> return x @@ -106,7 +106,7 @@ sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool {-# INLINE sameMutableArray #-} sameMutableArray (MutableArray arr#) (MutableArray brr#) - = sameMutableArray# arr# brr# + = isTrue# (sameMutableArray# arr# brr#) -- | Copy a slice of an immutable array to a mutable array. copyArray :: PrimMonad m @@ -165,4 +165,3 @@ toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray" - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/ByteArray.hs new/primitive-0.5.2.1/Data/Primitive/ByteArray.hs --- old/primitive-0.5.0.1/Data/Primitive/ByteArray.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/ByteArray.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,5 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, ForeignFunctionInterface, - UnliftedFFITypes, DeriveDataTypeable #-} +{-# LANGUAGE CPP, MagicHash, UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.ByteArray @@ -8,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Primitive operations on ByteArrays -- @@ -47,7 +46,7 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) @@ -99,7 +98,7 @@ sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool {-# INLINE sameMutableByteArray #-} sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#) - = sameMutableByteArray# arr# brr# + = isTrue# (sameMutableByteArray# arr# brr#) -- | Convert a mutable byte array to an immutable one without copying. The -- array should not be modified after the conversion. @@ -151,8 +150,8 @@ = primitive_ (writeByteArray# arr# i# x) #if __GLASGOW_HASKELL__ >= 702 -i# :: Int -> Int# -i# (I# n#) = n# +unI# :: Int -> Int# +unI# (I# n#) = n# #endif -- | Copy a slice of an immutable byte array to a mutable byte array. @@ -167,7 +166,7 @@ {-# INLINE copyByteArray #-} copyByteArray (MutableByteArray dst#) doff (ByteArray src#) soff sz #if __GLASGOW_HASKELL__ >= 702 - = primitive_ (copyByteArray# src# (i# soff) dst# (i# doff) (i# sz)) + = primitive_ (copyByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz)) #else = unsafePrimToPrim $ memcpy_ba dst# (fromIntegral doff) src# (fromIntegral soff) @@ -189,7 +188,7 @@ copyMutableByteArray (MutableByteArray dst#) doff (MutableByteArray src#) soff sz #if __GLASGOW_HASKELL__ >= 702 - = primitive_ (copyMutableByteArray# src# (i# soff) dst# (i# doff) (i# sz)) + = primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz)) #else = unsafePrimToPrim $ memcpy_mba dst# (fromIntegral doff) src# (fromIntegral soff) @@ -237,8 +236,7 @@ {-# INLINE fillByteArray #-} fillByteArray = setByteArray - - +#if __GLASGOW_HASKELL__ < 702 foreign import ccall unsafe "primitive-memops.h hsprimitive_memcpy" memcpy_mba :: MutableByteArray# s -> CInt -> MutableByteArray# s -> CInt @@ -248,6 +246,7 @@ memcpy_ba :: MutableByteArray# s -> CInt -> ByteArray# -> CInt -> CSize -> IO () +#endif foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove" memmove_mba :: MutableByteArray# s -> CInt @@ -263,4 +262,3 @@ toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/Internal/Compat.hs new/primitive-0.5.2.1/Data/Primitive/Internal/Compat.hs --- old/primitive-0.5.0.1/Data/Primitive/Internal/Compat.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/Internal/Compat.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, MagicHash #-} + -- | -- Module : Data.Primitive.Internal.Compat -- Copyright : (c) Roman Leshchinskiy 2011-2012 @@ -5,17 +7,32 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Compatibility functions -- -module Data.Primitive.Internal.Compat (mkNoRepType) where +module Data.Primitive.Internal.Compat ( + isTrue# + , mkNoRepType + ) where #if MIN_VERSION_base(4,2,0) import Data.Data (mkNoRepType) #else import Data.Data (mkNorepType) +#endif + +#if MIN_VERSION_base(4,7,0) +import GHC.Exts (isTrue#) +#endif + + +#if !MIN_VERSION_base(4,2,0) mkNoRepType = mkNorepType #endif +#if !MIN_VERSION_base(4,7,0) +isTrue# :: Bool -> Bool +isTrue# b = b +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/Internal/Operations.hs new/primitive-0.5.2.1/Data/Primitive/Internal/Operations.hs --- old/primitive-0.5.0.1/Data/Primitive/Internal/Operations.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/Internal/Operations.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, ForeignFunctionInterface, UnliftedFFITypes #-} +{-# LANGUAGE MagicHash, UnliftedFFITypes #-} -- | -- Module : Data.Primitive.Internal.Operations @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Internal operations -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/MachDeps.hs new/primitive-0.5.2.1/Data/Primitive/MachDeps.hs --- old/primitive-0.5.0.1/Data/Primitive/MachDeps.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/MachDeps.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP, MagicHash #-} -- | -- Module : Data.Primitive.MachDeps -- Copyright : (c) Roman Leshchinskiy 2009-2012 @@ -6,7 +6,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Machine-dependent constants -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/MutVar.hs new/primitive-0.5.2.1/Data/Primitive/MutVar.hs --- old/primitive-0.5.0.1/Data/Primitive/MutVar.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/MutVar.hs 2014-02-19 20:25:03.000000000 +0100 @@ -7,24 +7,27 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Primitive boxed mutable variables -- module Data.Primitive.MutVar ( MutVar(..), - + newMutVar, readMutVar, writeMutVar, atomicModifyMutVar, - modifyMutVar + atomicModifyMutVar', + modifyMutVar, + modifyMutVar' ) where import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, readMutVar#, writeMutVar#, atomicModifyMutVar# ) +import Data.Primitive.Internal.Compat ( isTrue# ) import Data.Typeable ( Typeable ) -- | A 'MutVar' behaves like a single-element mutable array associated @@ -33,7 +36,7 @@ deriving ( Typeable ) instance Eq (MutVar s a) where - MutVar mva# == MutVar mvb# = sameMutVar# mva# mvb# + MutVar mva# == MutVar mvb# = isTrue# (sameMutVar# mva# mvb#) -- | Create a new 'MutVar' with the specified initial value newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) @@ -57,9 +60,27 @@ {-# INLINE atomicModifyMutVar #-} atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f --- | Mutate the contents of a 'MutVar' +-- | Strict version of 'atomicModifyMutVar'. This forces both the value stored +-- in the 'MutVar' as well as the value returned. +atomicModifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a, b)) -> m b +{-# INLINE atomicModifyMutVar' #-} +atomicModifyMutVar' mv f = do + b <- atomicModifyMutVar mv force + b `seq` return b + where + force x = let (a, b) = f x in (a, a `seq` b) + +-- | Mutate the contents of a 'MutVar' modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () {-# INLINE modifyMutVar #-} modifyMutVar (MutVar mv#) g = primitive_ $ \s# -> case readMutVar# mv# s# of (# s'#, a #) -> writeMutVar# mv# (g a) s'# + +-- | Strict version of 'modifyMutVar' +modifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () +{-# INLINE modifyMutVar' #-} +modifyMutVar' (MutVar mv#) g = primitive_ $ \s# -> + case readMutVar# mv# s# of + (# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'# + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive/Types.hs new/primitive-0.5.2.1/Data/Primitive/Types.hs --- old/primitive-0.5.0.1/Data/Primitive/Types.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive/Types.hs 2014-02-19 20:25:03.000000000 +0100 @@ -1,4 +1,4 @@ -{-# LANGUAGE UnboxedTuples, MagicHash, DeriveDataTypeable #-} +{-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.Types @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Basic types and classes for primitive array operations -- @@ -22,7 +22,6 @@ import Data.Primitive.Internal.Operations import GHC.Base ( - unsafeCoerce#, Int(..), Char(..), ) import GHC.Float ( @@ -42,20 +41,20 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | A machine address data Addr = Addr Addr# deriving ( Typeable ) instance Eq Addr where - Addr a# == Addr b# = eqAddr# a# b# - Addr a# /= Addr b# = neAddr# a# b# + Addr a# == Addr b# = isTrue# (eqAddr# a# b#) + Addr a# /= Addr b# = isTrue# (neAddr# a# b#) instance Ord Addr where - Addr a# > Addr b# = gtAddr# a# b# - Addr a# >= Addr b# = geAddr# a# b# - Addr a# < Addr b# = ltAddr# a# b# - Addr a# <= Addr b# = leAddr# a# b# + Addr a# > Addr b# = isTrue# (gtAddr# a# b#) + Addr a# >= Addr b# = isTrue# (geAddr# a# b#) + Addr a# < Addr b# = isTrue# (ltAddr# a# b#) + Addr a# <= Addr b# = isTrue# (leAddr# a# b#) instance Data Addr where toConstr _ = error "toConstr" @@ -114,16 +113,16 @@ { (# s1#, x# #) -> (# s1#, ctr x# #) } \ ; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s# \ ; setByteArray# arr# i# n# (ctr x#) s# \ - = case internal (set_arr arr# i# n# x#) (unsafeCoerce# s#) of \ - { (# s1#, _ #) -> unsafeCoerce# s1# } \ + = case unsafeCoerce# (internal (set_arr arr# i# n# x#)) s# of \ + { (# s1#, _ #) -> s1# } \ \ ; indexOffAddr# addr# i# = ctr (idx_addr addr# i#) \ ; readOffAddr# addr# i# s# = case rd_addr addr# i# s# of \ { (# s1#, x# #) -> (# s1#, ctr x# #) } \ ; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s# \ ; setOffAddr# addr# i# n# (ctr x#) s# \ - = case internal (set_addr addr# i# n# x#) (unsafeCoerce# s#) of \ - { (# s1#, _ #) -> unsafeCoerce# s1# } \ + = case unsafeCoerce# (internal (set_addr addr# i# n# x#)) s# of \ + { (# s1#, _ #) -> s1# } \ ; {-# INLINE sizeOf# #-} \ ; {-# INLINE alignment# #-} \ ; {-# INLINE indexByteArray# #-} \ @@ -181,4 +180,3 @@ derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR, indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/Data/Primitive.hs new/primitive-0.5.2.1/Data/Primitive.hs --- old/primitive-0.5.0.1/Data/Primitive.hs 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/Data/Primitive.hs 2014-02-19 20:25:03.000000000 +0100 @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --- +-- -- Reexports all primitive operations -- module Data.Primitive ( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/cbits/primitive-memops.c new/primitive-0.5.2.1/cbits/primitive-memops.c --- old/primitive-0.5.0.1/cbits/primitive-memops.c 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/cbits/primitive-memops.c 2014-02-19 20:25:03.000000000 +0100 @@ -19,7 +19,7 @@ memset(p, 0, n * sizeof(Hs ## TYPE)); \ else if (sizeof(Hs ## TYPE) == sizeof(int)*2) { \ int *q = (int *)p; \ - const int *r = (const int *)&x; \ + const int *r = (const int *)(void *)&x; \ while (n>0) { \ q[0] = r[0]; \ q[1] = r[1]; \ @@ -49,4 +49,3 @@ MEMSET(Float, HsFloat) MEMSET(Double, HsDouble) MEMSET(Char, HsChar) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/changelog new/primitive-0.5.2.1/changelog --- old/primitive-0.5.0.1/changelog 1970-01-01 01:00:00.000000000 +0100 +++ new/primitive-0.5.2.1/changelog 2014-02-19 20:25:03.000000000 +0100 @@ -0,0 +1,41 @@ +Changes in version 0.5.2.0 + + * Add strict variants of 'MutVar' modification functions + +Changes in version 0.5.1.0 + + * Add support for GHC 7.7's new primitive 'Bool' representation + +Changes in version 0.5.0.1 + + * Disable array copying primitives for GHC 7.6.* and earlier + +Changes in version 0.5 + + * New in "Data.Primitive.MutVar": 'atomicModifyMutVar' + + * Efficient block fill operations: 'setByteArray', 'setAddr' + +Changes in version 0.4.1 + + * New module "Data.Primitive.MutVar" + +Changes in version 0.4.0.1 + + * Critical bug fix in 'fillByteArray' + +Changes in version 0.4 + + * Support for GHC 7.2 array copying primitives + + * New in "Data.Primitive.ByteArray": 'copyByteArray', + 'copyMutableByteArray', 'moveByteArray', 'fillByteArray' + + * Deprecated in "Data.Primitive.ByteArray": 'memcpyByteArray', + 'memcpyByteArray'', 'memmoveByteArray', 'memsetByteArray' + + * New in "Data.Primitive.Array": 'copyArray', 'copyMutableByteArray' + + * New in "Data.Primitive.Addr": 'copyAddr', 'moveAddr' + + * Deprecated in "Data.Primitive.Addr": 'memcpyAddr' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.5.0.1/primitive.cabal new/primitive-0.5.2.1/primitive.cabal --- old/primitive-0.5.0.1/primitive.cabal 2012-10-10 23:47:01.000000000 +0200 +++ new/primitive-0.5.2.1/primitive.cabal 2014-02-19 20:25:03.000000000 +0100 @@ -1,33 +1,27 @@ Name: primitive -Version: 0.5.0.1 +Version: 0.5.2.1 License: BSD3 License-File: LICENSE + Author: Roman Leshchinskiy <rl@cse.unsw.edu.au> Maintainer: Roman Leshchinskiy <rl@cse.unsw.edu.au> Copyright: (c) Roman Leshchinskiy 2009-2012 -Homepage: http://code.haskell.org/primitive +Homepage: https://github.com/haskell/primitive +Bug-Reports: https://github.com/haskell/primitive/issues Category: Data Synopsis: Primitive memory-related operations -Description: - . - This package provides various primitive memory-related operations. - . - Changes in version 0.5.0.1 - . - * Disable array copying primitives for GHC 7.6.* and earlier - . - Changes in version 0.5 - . - * New in "Data.Primitive.MutVar": @atomicModifyMutVar@ - . - * Efficient block fill operations: @setByteArray@, @setAddr@ - . - -Cabal-Version: >= 1.2 +Cabal-Version: >= 1.10 Build-Type: Simple +Description: This package provides various primitive memory-related operations. + +Extra-Source-Files: changelog Library - Extensions: CPP + Default-Language: Haskell2010 + Other-Extensions: + BangPatterns, CPP, DeriveDataTypeable, + MagicHash, TypeFamilies, UnboxedTuples, UnliftedFFITypes + Exposed-Modules: Control.Monad.Primitive Data.Primitive @@ -42,16 +36,20 @@ Data.Primitive.Internal.Compat Data.Primitive.Internal.Operations - Build-Depends: base >= 4 && < 5, ghc-prim + Build-Depends: base >= 4.3 && < 4.8, ghc-prim >= 0.2 && < 0.4 - Ghc-Options: -O2 + Ghc-Options: -O2 -Wall Include-Dirs: cbits Install-Includes: primitive-memops.h includes: primitive-memops.h c-sources: cbits/primitive-memops.c - cc-options: -O3 -ftree-vectorize -fomit-frame-pointer - if arch(i386) || arch(x86_64) { - cc-options: -msse2 - } - + cc-options: -O3 -fomit-frame-pointer -Wall + if !os(solaris) + cc-options: -ftree-vectorize + if arch(i386) || arch(x86_64) + cc-options: -msse2 + +source-repository head + type: git + location: https://github.com/haskell/primitive -- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org