Remove support for ghc < 8.4 (#682)

Along the way: * Obseleted CPP and compatibility workarounds were removed * Most remaining CPP conditions are moved into bytestring-cpp-macros.h and given specific feature names * Most imports from ghc-prim are replaced with equivalent imports from base * Data.ByteString.Builder.RealFloat.Internal is left untouched, to avoid unnecessary conflicts
haskell · Jun 16, 2024 · 0816ae5 · 0816ae5
1 parent c4db494
commit 0816ae5
Show file tree

Hide file tree

Showing 10 changed files with 58 additions and 143 deletions.
diff --git 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
@@ -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,60 +177,37 @@ 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
 
 -- 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
@@ -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
@@ -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.