Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-primitive for openSUSE:Factory checked in at 2023-04-04 21:22:33 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-primitive (Old) and /work/SRC/openSUSE:Factory/.ghc-primitive.new.19717 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-primitive" Tue Apr 4 21:22:33 2023 rev:28 rq:1076005 version:0.7.4.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-primitive/ghc-primitive.changes 2022-08-01 21:31:55.629919525 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-primitive.new.19717/ghc-primitive.changes 2023-04-04 21:22:44.409985169 +0200 @@ -1,0 +2,23 @@ +Thu Mar 30 17:07:58 UTC 2023 - Peter Simons <[email protected]> + +- Updated spec file to conform with ghc-rpm-macros-2.5.2. + +------------------------------------------------------------------- +Tue Jan 17 13:34:06 UTC 2023 - Peter Simons <[email protected]> + +- Update primitive to version 0.7.4.0 revision 1. + ## 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 + +------------------------------------------------------------------- Old: ---- primitive-0.7.3.0.tar.gz New: ---- primitive-0.7.4.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-primitive.spec ++++++ --- /var/tmp/diff_new_pack.3XvMP2/_old 2023-04-04 21:22:45.177989516 +0200 +++ /var/tmp/diff_new_pack.3XvMP2/_new 2023-04-04 21:22:45.181989538 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-primitive # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,28 +17,42 @@ %global pkg_name primitive +%global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.7.3.0 +Version: 0.7.4.0 Release: 0 Summary: Primitive memory-related operations License: BSD-3-Clause 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/2.cabal#/%{pkg_name}.cabal +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-base-devel +BuildRequires: ghc-base-prof BuildRequires: ghc-deepseq-devel +BuildRequires: ghc-deepseq-prof BuildRequires: ghc-rpm-macros +BuildRequires: ghc-template-haskell-devel +BuildRequires: ghc-template-haskell-prof BuildRequires: ghc-transformers-devel +BuildRequires: ghc-transformers-prof ExcludeArch: %{ix86} %if %{with tests} BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-QuickCheck-prof BuildRequires: ghc-base-orphans-devel +BuildRequires: ghc-base-orphans-prof BuildRequires: ghc-quickcheck-classes-base-devel +BuildRequires: ghc-quickcheck-classes-base-prof BuildRequires: ghc-tagged-devel +BuildRequires: ghc-tagged-prof BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-prof BuildRequires: ghc-tasty-quickcheck-devel +BuildRequires: ghc-tasty-quickcheck-prof BuildRequires: ghc-transformers-compat-devel +BuildRequires: ghc-transformers-compat-prof %endif %description @@ -54,6 +68,22 @@ %description devel This package provides the Haskell %{pkg_name} library development files. +%package -n ghc-%{pkg_name}-doc +Summary: Haskell %{pkg_name} library documentation +Requires: ghc-filesystem +BuildArch: noarch + +%description -n ghc-%{pkg_name}-doc +This package provides the Haskell %{pkg_name} library documentation. + +%package -n ghc-%{pkg_name}-prof +Summary: Haskell %{pkg_name} profiling library +Requires: ghc-%{pkg_name}-devel = %{version}-%{release} +Supplements: (ghc-%{pkg_name}-devel and ghc-prof) + +%description -n ghc-%{pkg_name}-prof +This package provides the Haskell %{pkg_name} profiling library. + %prep %autosetup -n %{pkg_name}-%{version} cp -p %{SOURCE1} %{pkg_name}.cabal @@ -79,4 +109,9 @@ %files devel -f %{name}-devel.files %doc changelog.md +%files -n ghc-%{pkg_name}-doc -f ghc-%{pkg_name}-doc.files +%license LICENSE + +%files -n ghc-%{pkg_name}-prof -f ghc-%{pkg_name}-prof.files + %changelog ++++++ primitive-0.7.3.0.tar.gz -> primitive-0.7.4.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/Array.hs new/primitive-0.7.4.0/Data/Primitive/Array.hs --- old/primitive-0.7.3.0/Data/Primitive/Array.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/Array.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/ByteArray.hs new/primitive-0.7.4.0/Data/Primitive/ByteArray.hs --- old/primitive-0.7.3.0/Data/Primitive/ByteArray.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/ByteArray.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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,17 +329,21 @@ #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 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/MachDeps.hs new/primitive-0.7.4.0/Data/Primitive/MachDeps.hs --- old/primitive-0.7.3.0/Data/Primitive/MachDeps.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/MachDeps.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/PrimArray.hs new/primitive-0.7.4.0/Data/Primitive/PrimArray.hs --- old/primitive-0.7.3.0/Data/Primitive/PrimArray.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/PrimArray.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 @@ -408,6 +416,24 @@ 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. -- -- /Note:/ this function does not do bounds checking. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/Ptr.hs new/primitive-0.7.4.0/Data/Primitive/Ptr.hs --- old/primitive-0.7.3.0/Data/Primitive/Ptr.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/Ptr.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/SmallArray.hs new/primitive-0.7.4.0/Data/Primitive/SmallArray.hs --- old/primitive-0.7.3.0/Data/Primitive/SmallArray.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/SmallArray.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/Data/Primitive/Types.hs new/primitive-0.7.4.0/Data/Primitive/Types.hs --- old/primitive-0.7.3.0/Data/Primitive/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/Data/Primitive/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/changelog.md new/primitive-0.7.4.0/changelog.md --- old/primitive-0.7.3.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 @@ -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`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/primitive.cabal new/primitive-0.7.4.0/primitive.cabal --- old/primitive-0.7.3.0/primitive.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/primitive.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -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 <[email protected]> @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/primitive-0.7.3.0/test/main.hs new/primitive-0.7.4.0/test/main.hs --- old/primitive-0.7.3.0/test/main.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/primitive-0.7.4.0/test/main.hs 2001-09-09 03:46:40.000000000 +0200 @@ -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 ++++++ primitive.cabal ++++++ --- /var/tmp/diff_new_pack.3XvMP2/_old 2023-04-04 21:22:45.333990400 +0200 +++ /var/tmp/diff_new_pack.3XvMP2/_new 2023-04-04 21:22:45.337990422 +0200 @@ -1,8 +1,8 @@ -Cabal-Version: 2.2 +Cabal-Version: 2.0 Name: primitive -Version: 0.7.3.0 -x-revision: 2 -License: BSD-3-Clause +Version: 0.7.4.0 +x-revision: 1 +License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <[email protected]> @@ -20,7 +20,6 @@ test/LICENSE Tested-With: - GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, @@ -50,11 +49,10 @@ Other-Modules: Data.Primitive.Internal.Operations - Build-Depends: base >= 4.8 && < 4.17 + Build-Depends: base >= 4.9 && < 4.19 , 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 @@ -83,10 +81,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 @@ -108,7 +104,7 @@ , primitive , deepseq , tasty-bench - , transformers >= 0.3 + , transformers >= 0.5 source-repository head type: git
