diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b48f79fa5..9a58cca09 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -18,17 +18,13 @@ jobs: fail-fast: true matrix: os: [ubuntu-latest] - ghc: ['8.0', '8.2', '8.4', '8.6', '8.8', '8.10', '9.0', '9.2', '9.4', '9.6', '9.8'] + ghc: ['8.4', '8.6', '8.8', '8.10', '9.0', '9.2', '9.4', '9.6', '9.8', '9.10'] include: - os: macOS-latest ghc: 'latest' steps: - uses: actions/checkout@v4 - - name: Install libncurses5 and libtinfo - if: runner.os == 'Linux' && (matrix.ghc == '8.0' || matrix.ghc == '8.2') - run: | - sudo apt-get install libncurses5 libtinfo5 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell-cabal with: ghc-version: ${{ matrix.ghc }} @@ -67,10 +63,10 @@ jobs: strategy: fail-fast: true matrix: - ghc: ['9.2', '9.4', '9.6'] + ghc: ['9.2', '9.4', '9.6', '9.8', '9.10'] steps: - uses: actions/checkout@v4 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell-cabal with: ghc-version: ${{ matrix.ghc }} @@ -151,7 +147,7 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell-cabal with: ghc-version: 'latest' @@ -172,7 +168,7 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell/actions/setup@v2 + - uses: haskell-actions/setup@v2 id: setup-haskell-cabal with: ghc-version: 'latest' diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs index 1759ab93e..3038cea5e 100644 --- a/Data/ByteString/Internal/Type.hs +++ b/Data/ByteString/Internal/Type.hs @@ -8,6 +8,8 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE ViewPatterns #-} +#include "bytestring-cpp-macros.h" + -- | -- Module : Data.ByteString.Internal.Type -- Copyright : (c) Don Stewart 2006-2008 @@ -143,10 +145,7 @@ import Data.Maybe (fromMaybe) import Control.Monad ((<$!>)) #endif -#if !MIN_VERSION_base(4,13,0) -import Data.Semigroup (Semigroup ((<>))) -#endif -import Data.Semigroup (Semigroup (sconcat, stimes)) +import Data.Semigroup (Semigroup (..)) import Data.List.NonEmpty (NonEmpty ((:|))) import Control.DeepSeq (NFData(rnf)) @@ -159,18 +158,15 @@ import Data.Bits ((.&.)) import Data.Char (ord) import Data.Word -import Data.Data (Data(..), mkConstr ,mkDataType, Constr, DataType, Fixity(Prefix), constrIndex) +import Data.Data (Data(..), mkConstr, mkDataType, Constr, DataType, Fixity(Prefix), constrIndex) -import GHC.Base (nullAddr#,realWorld#,unsafeChr) -import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#) -import GHC.CString (unpackCString#) -import GHC.Magic (runRW#, lazy) +import GHC.Base (nullAddr#,realWorld#,unsafeChr,unpackCString#) +import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#, runRW#, lazy) -#define TIMES_INT_2_AVAILABLE MIN_VERSION_ghc_prim(0,7,0) -#if TIMES_INT_2_AVAILABLE -import GHC.Prim (timesInt2#) +#if HS_timesInt2_PRIMOP_AVAILABLE +import GHC.Exts (timesInt2#) #else -import GHC.Prim ( timesWord2# +import GHC.Exts ( timesWord2# , or# , uncheckedShiftRL# , int2Word# @@ -181,34 +177,30 @@ import Data.Bits (finiteBitSize) import GHC.IO (IO(IO)) import GHC.ForeignPtr (ForeignPtr(ForeignPtr) -#if __GLASGOW_HASKELL__ < 900 +#if !HS_cstringLength_AND_FinalPtr_AVAILABLE , newForeignPtr_ #endif , mallocPlainForeignPtrBytes) -#if MIN_VERSION_base(4,10,0) import GHC.ForeignPtr (plusForeignPtr) -#else -import GHC.Prim (plusAddr#) -#endif -#if __GLASGOW_HASKELL__ >= 811 -import GHC.CString (cstringLength#) +#if HS_cstringLength_AND_FinalPtr_AVAILABLE +import GHC.Exts (cstringLength#) import GHC.ForeignPtr (ForeignPtrContents(FinalPtr)) #else import GHC.Ptr (Ptr(..)) #endif -import GHC.Types (Int (..)) +import GHC.Int (Int (..)) -#if MIN_VERSION_base(4,15,0) +#if HS_unsafeWithForeignPtr_AVAILABLE import GHC.ForeignPtr (unsafeWithForeignPtr) #endif import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH -#if !MIN_VERSION_base(4,15,0) +#if !HS_unsafeWithForeignPtr_AVAILABLE unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr = withForeignPtr #endif @@ -216,25 +208,6 @@ unsafeWithForeignPtr = withForeignPtr -- CFILES stuff is Hugs only {-# CFILES cbits/fpstring.c #-} -#if !MIN_VERSION_base(4,10,0) --- |Advances the given address by the given offset in bytes. --- --- The new 'ForeignPtr' shares the finalizer of the original, --- equivalent from a finalization standpoint to just creating another --- reference to the original. That is, the finalizer will not be --- called before the new 'ForeignPtr' is unreachable, nor will it be --- called an additional time due to this call, and the finalizer will --- be called with the same address that it would have had this call --- not happened, *not* the new address. -plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts -{-# INLINE [0] plusForeignPtr #-} -{-# RULES -"ByteString plusForeignPtr/0" forall fp . - plusForeignPtr fp 0 = fp - #-} -#endif - minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int minusForeignPtr (ForeignPtr addr1 _) (ForeignPtr addr2 _) = I# (minusAddr# addr1 addr2) @@ -332,9 +305,7 @@ type StrictByteString = ByteString pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where PS fp o len = BS (plusForeignPtr fp o) len -#if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE PS #-} -#endif instance Eq ByteString where (==) = eq @@ -391,6 +362,7 @@ byteStringDataType = mkDataType "Data.ByteString.ByteString" [packConstr] -- | @since 0.11.2.0 instance TH.Lift ByteString where #if MIN_VERSION_template_haskell(2,16,0) +-- template-haskell-2.16 first ships with ghc-8.10 lift (BS ptr len) = [| unsafePackLenLiteral |] `TH.appE` TH.litE (TH.integerL (fromIntegral len)) `TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len)) @@ -401,8 +373,10 @@ instance TH.Lift ByteString where #endif #if MIN_VERSION_template_haskell(2,17,0) +-- template-haskell-2.17 first ships with ghc-9.0 liftTyped = TH.unsafeCodeCoerce . TH.lift #elif MIN_VERSION_template_haskell(2,16,0) +-- template-haskell-2.16 first ships with ghc-8.10 liftTyped = TH.unsafeTExpCoerce . TH.lift #endif @@ -478,7 +452,7 @@ unsafePackLenChars len cs0 = -- unsafePackAddress :: Addr# -> IO ByteString unsafePackAddress addr# = do -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenAddress (I# (cstringLength# addr#)) addr# #else l <- c_strlen (Ptr addr#) @@ -494,7 +468,7 @@ unsafePackAddress addr# = do -- @since 0.11.2.0 unsafePackLenAddress :: Int -> Addr# -> IO ByteString unsafePackLenAddress len addr# = do -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE return (BS (ForeignPtr addr# FinalPtr) len) #else p <- newForeignPtr_ (Ptr addr#) @@ -511,7 +485,7 @@ unsafePackLenAddress len addr# = do -- @since 0.11.1.0 unsafePackLiteral :: Addr# -> ByteString unsafePackLiteral addr# = -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenLiteral (I# (cstringLength# addr#)) addr# #else let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#)) @@ -528,7 +502,7 @@ unsafePackLiteral addr# = -- @since 0.11.2.0 unsafePackLenLiteral :: Int -> Addr# -> ByteString unsafePackLenLiteral len addr# = -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE BS (ForeignPtr addr# FinalPtr) len #else -- newForeignPtr_ allocates a MutVar# internally. If that MutVar# @@ -621,7 +595,7 @@ unpackAppendCharsStrict (BS fp len) xs = -- | The 0 pointer. Used to indicate the empty Bytestring. nullForeignPtr :: ForeignPtr Word8 -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE nullForeignPtr = ForeignPtr nullAddr# FinalPtr #else nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr") @@ -1039,7 +1013,7 @@ checkedAdd fun x y checkedMultiply :: String -> Int -> Int -> Int {-# INLINE checkedMultiply #-} checkedMultiply fun !x@(I# x#) !y@(I# y#) = assert (min x y >= 0) $ -#if TIMES_INT_2_AVAILABLE +#if HS_timesInt2_PRIMOP_AVAILABLE case timesInt2# x# y# of (# 0#, _, result #) -> I# result _ -> overflowError fun diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs index 8135c8234..f93f3d34f 100644 --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -53,11 +53,7 @@ import qualified Data.ByteString.Internal.Type as S import Data.Word (Word8) import Foreign.Storable (Storable(sizeOf)) -#if MIN_VERSION_base(4,13,0) -import Data.Semigroup (Semigroup (sconcat, stimes)) -#else -import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) -#endif +import Data.Semigroup (Semigroup (..)) import Data.List.NonEmpty (NonEmpty ((:|))) import Control.DeepSeq (NFData, rnf) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 68fcb52ce..a36570256 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -7,7 +7,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnliftedFFITypes #-} -{-# LANGUAGE ViewPatterns #-} #include "bytestring-cpp-macros.h" @@ -184,12 +183,6 @@ import Foreign.C.String ( CString , CStringLen ) -#if !HS_compareByteArrays_PRIMOP_AVAILABLE && !PURE_HASKELL -import Foreign.C.Types - ( CSize(..) - , CInt(..) - ) -#endif import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Storable @@ -202,13 +195,9 @@ import GHC.Exts , byteArrayContents# , unsafeCoerce# , copyMutableByteArray# -#if HS_isByteArrayPinned_PRIMOP_AVAILABLE , isByteArrayPinned# , isTrue# -#endif -#if HS_compareByteArrays_PRIMOP_AVAILABLE , compareByteArrays# -#endif , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array# @@ -277,11 +266,7 @@ newtype ShortByteString = -- but now it is a bundled pattern synonym, provided as a compatibility shim. pattern SBS :: ByteArray# -> ShortByteString pattern SBS x = ShortByteString (ByteArray x) -#if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE SBS #-} --- To avoid spurious warnings from CI with ghc-8.0, we internally --- use view patterns like (unSBS -> ba#) instead of using (SBS ba#) -#endif -- | Lexicographic order. instance Ord ShortByteString where @@ -331,7 +316,7 @@ empty = create 0 (\_ -> return ()) -- | /O(1)/ The length of a 'ShortByteString'. length :: ShortByteString -> Int -length (unSBS -> barr#) = I# (sizeofByteArray# barr#) +length (SBS barr#) = I# (sizeofByteArray# barr#) -- | /O(1)/ Test whether a 'ShortByteString' is empty. null :: ShortByteString -> Bool @@ -380,9 +365,6 @@ indexError sbs i = asBA :: ShortByteString -> ByteArray asBA (ShortByteString ba) = ba -unSBS :: ShortByteString -> ByteArray# -unSBS (ShortByteString (ByteArray ba#)) = ba# - create :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ShortByteString create len fill = assert (len >= 0) $ runST $ do @@ -449,11 +431,7 @@ createAndTrim2 maxLen1 maxLen2 fill = {-# INLINE createAndTrim2 #-} isPinned :: ByteArray# -> Bool -#if HS_isByteArrayPinned_PRIMOP_AVAILABLE isPinned ba# = isTrue# (isByteArrayPinned# ba#) -#else -isPinned _ = False -#endif ------------------------------------------------------------------------ -- Conversion to and from ByteString @@ -475,7 +453,7 @@ toShortIO (BS fptr len) = do -- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'. -- fromShort :: ShortByteString -> ByteString -fromShort sbs@(unSBS -> b#) +fromShort sbs@(SBS b#) | isPinned b# = BS inPlaceFp len | otherwise = BS.unsafeCreateFp len $ \fp -> BS.unsafeWithForeignPtr fp $ \p -> copyToPtr sbs 0 p len @@ -1492,7 +1470,7 @@ partition k = \sbs -> let len = length sbs -- -- @since 0.11.3.0 elemIndex :: Word8 -> ShortByteString -> Maybe Int -elemIndex c = \sbs@(unSBS -> ba#) -> do +elemIndex c = \sbs@(SBS ba#) -> do let l = length sbs accursedUnutterablePerformIO $ do !s <- c_elem_index ba# c (fromIntegral l) @@ -1510,7 +1488,7 @@ elemIndices k = findIndices (==k) -- -- @since 0.11.3.0 count :: Word8 -> ShortByteString -> Int -count w = \sbs@(unSBS -> ba#) -> accursedUnutterablePerformIO $ +count w = \sbs@(SBS ba#) -> accursedUnutterablePerformIO $ fromIntegral <$> BS.c_count_ba ba# (fromIntegral $ length sbs) w -- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and @@ -1641,24 +1619,8 @@ compareByteArraysOff :: ByteArray -- ^ array 1 -> Int -- ^ offset for array 2 -> Int -- ^ length to compare -> Int -- ^ like memcmp -#if HS_compareByteArrays_PRIMOP_AVAILABLE compareByteArraysOff (ByteArray ba1#) (I# ba1off#) (ByteArray ba2#) (I# ba2off#) (I# len#) = I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#) -#else -compareByteArraysOff (ByteArray ba1#) ba1off (ByteArray ba2#) ba2off len = - assert (ba1off + len <= (I# (sizeofByteArray# ba1#))) - $ assert (ba2off + len <= (I# (sizeofByteArray# ba2#))) - $ fromIntegral $ accursedUnutterablePerformIO $ - c_memcmp_ByteArray ba1# - ba1off - ba2# - ba2off - (fromIntegral len) - - -foreign import ccall unsafe "static sbs_memcmp_off" - c_memcmp_ByteArray :: ByteArray# -> Int -> ByteArray# -> Int -> CSize -> IO CInt -#endif ------------------------------------------------------------------------ -- Primop replacements @@ -1738,7 +1700,7 @@ useAsCStringLen sbs action = -- -- @since 0.11.3.0 isValidUtf8 :: ShortByteString -> Bool -isValidUtf8 sbs@(unSBS -> ba#) = accursedUnutterablePerformIO $ do +isValidUtf8 sbs@(SBS ba#) = accursedUnutterablePerformIO $ do let n = length sbs -- Use a safe FFI call for large inputs to avoid GC synchronization pauses -- in multithreaded contexts. diff --git a/Data/ByteString/Unsafe.hs b/Data/ByteString/Unsafe.hs index 3c4e3f5d2..0b6944770 100644 --- a/Data/ByteString/Unsafe.hs +++ b/Data/ByteString/Unsafe.hs @@ -47,7 +47,6 @@ module Data.ByteString.Unsafe ( import Data.ByteString.Internal import Foreign.ForeignPtr (newForeignPtr_, newForeignPtr, withForeignPtr) -import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import Foreign.C.String (CString, CStringLen) @@ -59,8 +58,8 @@ import Data.Word (Word8) import qualified Foreign.ForeignPtr as FC (finalizeForeignPtr) import qualified Foreign.Concurrent as FC (newForeignPtr) -import GHC.Prim (Addr#) -import GHC.Ptr (Ptr(..)) +import GHC.Exts (Addr#) +import GHC.Ptr (Ptr(..), castPtr) -- --------------------------------------------------------------------- -- diff --git a/Data/ByteString/Utils/ByteOrder.hs b/Data/ByteString/Utils/ByteOrder.hs index 9248b7cad..183953c07 100644 --- a/Data/ByteString/Utils/ByteOrder.hs +++ b/Data/ByteString/Utils/ByteOrder.hs @@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} +#include "MachDeps.h" + -- | Why does this module exist? There is "GHC.ByteOrder" in base. -- But that module is /broken/ until base-4.14/ghc-8.10, so we -- can't rely on it until we drop support for older ghcs. -- See https://gitlab.haskell.org/ghc/ghc/-/issues/20338 -- and https://gitlab.haskell.org/ghc/ghc/-/issues/18445 -#include "MachDeps.h" - module Data.ByteString.Utils.ByteOrder ( ByteOrder(..) , hostByteOrder @@ -15,9 +15,7 @@ module Data.ByteString.Utils.ByteOrder , whenBigEndian ) where -data ByteOrder - = LittleEndian - | BigEndian +import GHC.ByteOrder (ByteOrder(..)) hostByteOrder :: ByteOrder hostByteOrder = diff --git a/README.md b/README.md index 17c9ff2a7..5ed0a9bf2 100644 --- a/README.md +++ b/README.md @@ -15,8 +15,8 @@ of `ByteString` values from smaller pieces during binary serialization. Requirements: - * Cabal 1.10 or greater - * GHC 8.0 or greater + * Cabal 2.2 or greater + * GHC 8.4 or greater ### Authors diff --git a/bytestring.cabal b/bytestring.cabal index d5b0e3d52..6e371bc3c 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -57,15 +57,16 @@ Author: Don Stewart, Maintainer: Haskell Bytestring Team , Core Libraries Committee Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues -Tested-With: GHC==9.4.1, - GHC==9.2.4, +Tested-With: GHC==9.10.1, + GHC==9.8.2, + GHC==9.6.5, + GHC==9.4.8, + GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, - GHC==8.4.4, - GHC==8.2.2, - GHC==8.0.2 + GHC==8.4.4 Build-Type: Simple extra-source-files: README.md Changelog.md include/bytestring-cpp-macros.h @@ -108,7 +109,7 @@ common language library import: language - build-depends: base >= 4.9 && < 5, ghc-prim, deepseq, template-haskell + build-depends: base >= 4.11 && < 5, ghc-prim, deepseq, template-haskell if impl(ghc < 9.4) build-depends: data-array-byte >= 0.1 && < 0.2 @@ -212,7 +213,6 @@ test-suite bytestring-tests build-depends: base, bytestring, deepseq, - ghc-prim, QuickCheck, tasty, tasty-quickcheck >= 0.8.1, diff --git a/cbits/shortbytestring.c b/cbits/shortbytestring.c index 307a92233..c97b0eadd 100644 --- a/cbits/shortbytestring.c +++ b/cbits/shortbytestring.c @@ -4,21 +4,6 @@ #include -int -sbs_memcmp_off(const void *s1, - size_t off1, - const void *s2, - size_t off2, - size_t n) -{ - const void *s1o = s1 + off1; - const void *s2o = s2 + off2; - - int r = memcmp(s1o, s2o, n); - - return r; -} - ptrdiff_t sbs_elem_index(const void *s, uint8_t c, diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h index 1022eb5dd..350b52e3a 100644 --- a/include/bytestring-cpp-macros.h +++ b/include/bytestring-cpp-macros.h @@ -26,7 +26,7 @@ which are known not to trap (either to the kernel for emulation, or crash). MIN_VERSION_base(4,12,0) \ && (MIN_VERSION_base(4,16,1) || HS_UNALIGNED_POKES_OK) /* -The unaligned ByteArray# primops became available with base-4.12.0, +The unaligned ByteArray# primops became available with base-4.12.0/ghc-8.6, but require an unaligned-friendly host architecture to be safe to use until ghc-9.2.2; see https://gitlab.haskell.org/ghc/ghc/-/issues/21015 */ @@ -41,5 +41,10 @@ are buggy with negative floats before ghc-8.10. #define HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE MIN_VERSION_base(4,20,0) -#define HS_isByteArrayPinned_PRIMOP_AVAILABLE MIN_VERSION_base(4,10,0) -#define HS_compareByteArrays_PRIMOP_AVAILABLE MIN_VERSION_base(4,11,0) +#define HS_timesInt2_PRIMOP_AVAILABLE MIN_VERSION_base(4,15,0) + +#define HS_cstringLength_AND_FinalPtr_AVAILABLE MIN_VERSION_base(4,15,0) + /* These two were added in the same ghc commit and + both primarily affect how we handle literals */ + +#define HS_unsafeWithForeignPtr_AVAILABLE MIN_VERSION_base(4,15,0)