Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00 ghc-boot: remove unused SizedSeq instances and functions This commit removes unused `SizedSeq` instances and functions, only keeping the bits we need for hpc tick sequence for now. - - - - - 22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00 ghci: remove unused GHCi.BinaryArray This patch removes the unused `GHCi.BinaryArray` module from `ghci`. Closes #27108. - - - - - 4 changed files: - libraries/ghc-boot/GHC/Data/SizedSeq.hs - − libraries/ghci/GHCi/BinaryArray.hs - libraries/ghci/ghci.cabal.in - testsuite/tests/ghci/should_run/BinaryArray.hs Changes: ===================================== libraries/ghc-boot/GHC/Data/SizedSeq.hs ===================================== @@ -1,38 +1,14 @@ -{-# LANGUAGE StandaloneDeriving, DeriveGeneric, CPP #-} module GHC.Data.SizedSeq ( SizedSeq(..) , emptySS , addToSS - , addListToSS , ssElts , sizeSS ) where import Prelude -- See note [Why do we import Prelude here?] -import Control.DeepSeq -import Data.Binary -import GHC.Generics - -#if ! MIN_VERSION_base(4,20,0) -import Data.List (foldl') -#endif data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a] - deriving (Generic, Show) - -instance Functor SizedSeq where - fmap f (SizedSeq sz l) = SizedSeq sz (fmap f l) - -instance Foldable SizedSeq where - foldr f c ss = foldr f c (ssElts ss) - -instance Traversable SizedSeq where - traverse f (SizedSeq sz l) = SizedSeq sz . reverse <$> traverse f (reverse l) - -instance Binary a => Binary (SizedSeq a) - -instance NFData a => NFData (SizedSeq a) where - rnf (SizedSeq _ xs) = rnf xs emptySS :: SizedSeq a emptySS = SizedSeq 0 [] @@ -40,10 +16,6 @@ emptySS = SizedSeq 0 [] addToSS :: SizedSeq a -> a -> SizedSeq a addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs) --- NB, important this is eta-expand so that foldl' is inlined. -addListToSS :: SizedSeq a -> [a] -> SizedSeq a -addListToSS s xs = foldl' addToSS s xs - ssElts :: SizedSeq a -> [a] ssElts (SizedSeq _ r_xs) = reverse r_xs ===================================== libraries/ghci/GHCi/BinaryArray.hs deleted ===================================== @@ -1,80 +0,0 @@ -{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, FlexibleContexts #-} --- | Efficient serialisation for GHCi Instruction arrays --- --- Author: Ben Gamari --- -module GHCi.BinaryArray(putArray, getArray) where - -import Prelude -import Foreign.Ptr -import Data.Binary -import Data.Binary.Put (putBuilder) -import qualified Data.Binary.Get.Internal as Binary -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Builder.Internal as BB -import qualified Data.Array.Base as A -import qualified Data.Array.IO.Internals as A -import qualified Data.Array.Unboxed as A -import GHC.Exts -import GHC.IO - --- | An efficient serialiser of 'A.UArray'. -putArray :: Binary i => A.UArray i a -> Put -putArray (A.UArray l u _ arr#) = do - put l - put u - putBuilder $ byteArrayBuilder arr# - -byteArrayBuilder :: ByteArray# -> BB.Builder -byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#)) - where - go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a - go !inStart !inEnd k (BB.BufferRange outStart outEnd) - -- There is enough room in this output buffer to write all remaining array - -- contents - | inRemaining <= outRemaining = do - copyByteArrayToAddr arr# inStart outStart inRemaining - k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd) - -- There is only enough space for a fraction of the remaining contents - | otherwise = do - copyByteArrayToAddr arr# inStart outStart outRemaining - let !inStart' = inStart + outRemaining - return $! BB.bufferFull 1 outEnd (go inStart' inEnd k) - where - inRemaining = inEnd - inStart - outRemaining = outEnd `minusPtr` outStart - - copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO () - copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) = - IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of - s' -> (# s', () #) - --- | An efficient deserialiser of 'A.UArray'. -getArray :: (Binary i, A.Ix i, A.MArray A.IOUArray a IO) => Get (A.UArray i a) -getArray = do - l <- get - u <- get - arr@(A.IOUArray (A.STUArray _ _ _ arr#)) <- - return $ unsafeDupablePerformIO $ A.newArray_ (l,u) - let go 0 _ = return () - go !remaining !off = do - Binary.readNWith n $ \ptr -> - copyAddrToByteArray ptr arr# off n - go (remaining - n) (off + n) - where n = min chunkSize remaining - sz <- return $ unsafeDupablePerformIO $ IO $ \s -> case getSizeofMutableByteArray# arr# s of - (# s2, n #) -> (# s2, I# n #) - go sz 0 - return $! unsafeDupablePerformIO $ unsafeFreezeIOUArray arr - where - chunkSize = 10*1024 - - copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld - -> Int -> Int -> IO () - copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) = - IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of - s' -> (# s', () #) - --- this is inexplicably not exported in currently released array versions -unsafeFreezeIOUArray :: A.IOUArray ix e -> IO (A.UArray ix e) -unsafeFreezeIOUArray (A.IOUArray marr) = stToIO (A.unsafeFreezeSTUArray marr) ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -74,7 +74,6 @@ library exposed-modules: GHCi.BreakArray - GHCi.BinaryArray GHCi.Message GHCi.ResolvedBCO GHCi.RemoteTypes ===================================== testsuite/tests/ghci/should_run/BinaryArray.hs ===================================== @@ -4,25 +4,10 @@ import Data.Binary.Put import Data.Binary (Binary, get, put) import Data.Array.Byte import Data.Array.Unboxed as AU -import Data.Array.IO (IOUArray) -import Data.Array.MArray (MArray) -import Data.Array as A import Data.Array.Base as A -import Foreign.Storable -import GHCi.BinaryArray import GHCi.ResolvedBCO import GHC.Word -roundtripTest :: (IArray UArray a, MArray IOUArray a IO, Eq a) - => UArray Int a -> IO () -roundtripTest arr = - let ser = Data.Binary.Put.runPut $ putArray arr - in case Data.Binary.Get.runGetOrFail getArray ser of - Right (_, _, arr') - | arr == arr' -> return () - | otherwise -> putStrLn "failed to round-trip" - Left _ -> putStrLn "deserialization failed" - -- See Note [BCOByteArray serialization] roundtripTestByteArray :: forall a . (IArray UArray a, Eq a, Binary (BCOByteArray a)) => UArray Int a -> IO () @@ -37,12 +22,5 @@ roundtripTestByteArray (UArray _ _ _ arr#) = main :: IO () main = do - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Int) - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word) - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word8) - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word16) - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word32) - roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word64) - roundtripTest (AU.listArray (1,500) ['a'..] :: UArray Int Char) roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word) roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word16) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b6757d78e4e808678feb740ff5d4eb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b6757d78e4e808678feb740ff5d4eb... You're receiving this email because of your account on gitlab.haskell.org.