ghc-boot 9.12.4 → 9.14.1

raw patch · 7 files changed

+61/−325 lines, 7 filesdep ~basedep ~containersdep ~ghc-boot-thPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, ghc-boot-th, ghc-boot-th-next

API changes (from Hackage documentation)

Files

• GHC/BaseDir.hs +2/−6
• GHC/Data/ShortText.hs +1/−7
• GHC/Data/SizedSeq.hs +7/−4
• GHC/Serialized.hs +4/−0
• GHC/Utils/Encoding.hs +42/−42
• GHC/Utils/Encoding/UTF8.hs +0/−261
• ghc-boot.cabal +5/−5

@@ -24,7 +24,7 @@ import Data.Maybe (listToMaybe) import System.FilePath -#if MIN_VERSION_base(4,17,0) && !defined(openbsd_HOST_OS)+#if !defined(openbsd_HOST_OS) import System.Environment (executablePath) #else import System.Environment (getExecutablePath)@@ -45,16 +45,12 @@ expandPathVar var value (x:xs) = x : expandPathVar var value xs expandPathVar _ _ [] = [] -#if !MIN_VERSION_base(4,17,0) || defined(openbsd_HOST_OS)+#if defined(openbsd_HOST_OS) -- Polyfill for base-4.17 executablePath and OpenBSD which doesn't -- have executablePath. The best it can do is use argv[0] which is -- good enough for most uses of getBaseDir. executablePath :: Maybe (IO (Maybe FilePath)) executablePath = Just (Just <$> getExecutablePath)-#elif !MIN_VERSION_base(4,18,0) && defined(js_HOST_ARCH)--- executablePath is missing from base < 4.18.0 on js_HOST_ARCH-executablePath :: Maybe (IO (Maybe FilePath))-executablePath = Nothing #endif  -- | Calculate the location of the base dir

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies, CPP #-}+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- gross hack: we maneuvered ourselves into a position where we can't boot GHC with a LLVM based GHC anymore. -- LLVM based GHC's fail to compile memcmp ffi calls.  These end up as memcmp$def in the llvm ir, however we@@ -11,12 +11,6 @@ -- bootstrap compiler.  This will produce a slower (slightly less optimised) stage1 compiler only. -- -- See issue 18857. hsyl20 deserves credit for coming up with the idea for the solution.------ This can be removed when we exit the boot compiler window. Thus once we drop GHC-9.2 as boot compiler,--- we can drop this code as well.-#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)-{-# OPTIONS_GHC -fignore-interface-pragmas #-}-#endif -- | -- An Unicode string for internal GHC use. Meant to replace String -- in places where being a lazy linked is not very useful and a more

@@ -1,4 +1,4 @@-{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving, DeriveGeneric, CPP #-} module GHC.Data.SizedSeq   ( SizedSeq(..)   , emptySS@@ -11,9 +11,12 @@ import Prelude -- See note [Why do we import Prelude here?] import Control.DeepSeq import Data.Binary-import Data.List (genericLength) 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) @@ -37,9 +40,9 @@ 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 (SizedSeq n r_xs) xs-  = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)+addListToSS s xs = foldl' addToSS s xs  ssElts :: SizedSeq a -> [a] ssElts (SizedSeq _ r_xs) = reverse r_xs

@@ -22,10 +22,14 @@ import Data.Bits import Data.Word        ( Word8 ) import Data.Data+import Control.DeepSeq   -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types data Serialized = Serialized TypeRep [Word8]++instance NFData Serialized where+  rnf (Serialized tr ws) = rnf tr `seq` rnf ws  -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, MultiWayIf #-} {-# OPTIONS_GHC -O2 -fno-warn-name-shadowing #-} -- We always optimise this, otherwise performance of a non-optimised@@ -88,15 +89,48 @@   zEncodeString :: UserString -> EncodedString-zEncodeString cs = case maybe_tuple cs of-                Just n  -> n            -- Tuples go to Z2T etc-                Nothing -> go cs-          where-                go []     = []-                go (c:cs) = encode_digit_ch c ++ go' cs-                go' []     = []-                go' (c:cs) = encode_ch c ++ go' cs+zEncodeString = \case+  []     -> []+  (c:cs)+    -- If a digit is at the start of a symbol then we need to encode it.+    -- Otherwise package names like 9pH-0.1 give linker errors.+    | c >= '0' && c <= '9' -> encode_as_unicode_char c ++ go cs+    | otherwise            -> go (c:cs)+  where+    go = \case+      [] -> []+      -- encode boxed/unboxed tuples respectively as ZnT/ZnH (e.g. Z3T/Z3H for+      -- 3-tuples). Note that the arity corresponds to the number of+      -- commas+1. No comma means 0-arity, i.e. Z0T/Z0H.+      --+      -- The 1-arity unboxed tuple "(# #)" (notice the space between the '#'s)+      -- isn't special-cased, i.e. it is encoded as "ZLzhz20UzhZR". There is no+      -- 1-arity boxed tuple (we use Solo/MkSolo instead).+      --+      -- arity        boxed       z-name        unboxed       z-name+      -- 0            ()          Z0T           (##)          Z0H+      -- 1            N/A         N/A           (# #)         ZLzhz20UzhZR+      -- 2            (,)         Z2T           (#,#)         Z2H+      -- 3            (,,)        Z3T           (#,,#)        Z3H+      -- ...+      --+      '(':'#':'#':')':cs -> "Z0H" ++ go cs+      '(':')':cs         -> "Z0T" ++ go cs+      '(':'#':cs+        | (n, '#':')':cs') <- count_commas cs+        -> 'Z' : shows (n+1) ('H': go cs')+      '(':cs+        | (n, ')':cs') <- count_commas cs+        -> 'Z' : shows (n+1) ('T': go cs')+      c:cs -> encode_ch c ++ go cs +count_commas :: String -> (Int, String)+count_commas = go 0+  where+    go !n = \case+      ',':cs -> go (n+1) cs+      cs     -> (n,cs)+ unencodedChar :: Char -> Bool   -- True for chars that don't need encoding unencodedChar 'Z' = False unencodedChar 'z' = False@@ -104,12 +138,6 @@                   || c >= 'A' && c <= 'Z'                   || c >= '0' && c <= '9' --- If a digit is at the start of a symbol then we need to encode it.--- Otherwise package names like 9pH-0.1 give linker errors.-encode_digit_ch :: Char -> EncodedString-encode_digit_ch c | c >= '0' && c <= '9' = encode_as_unicode_char c-encode_digit_ch c | otherwise            = encode_ch c- encode_ch :: Char -> EncodedString encode_ch c | unencodedChar c = [c]     -- Common case first @@ -214,34 +242,6 @@     go n ('T':rest)     = '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest     go n ('H':rest)     = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ zDecodeString rest     go n other = error ("decode_tuple: " ++ show n ++ ' ':other)--{--Tuples are encoded as-        Z3T or Z3H-for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts-        Z<digit>--* "(##)" is the tycon for an unboxed 0-tuple--* "()" is the tycon for a boxed 0-tuple--}--maybe_tuple :: UserString -> Maybe EncodedString--maybe_tuple "(##)" = Just("Z0H")-maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of-                                 (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")-                                 _                  -> Nothing-maybe_tuple "()" = Just("Z0T")-maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of-                                 (n, ')' : _) -> Just ('Z' : shows (n+1) "T")-                                 _            -> Nothing-maybe_tuple _                = Nothing--count_commas :: Int -> String -> (Int, String)-count_commas n (',' : cs) = count_commas (n+1) cs-count_commas n cs         = (n,cs)-  {- ************************************************************************

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, MultiWayIf #-} {-# OPTIONS_GHC -O2 -fno-warn-name-shadowing #-} -- We always optimise this, otherwise performance of a non-optimised@@ -45,14 +44,7 @@  import Foreign import GHC.IO-#if MIN_VERSION_base(4,18,0) import GHC.Encoding.UTF8-#else-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Data.Char-import GHC.Exts-import GHC.ST-#endif  import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as BS@@ -106,256 +98,3 @@  utf8CompareShortByteString :: ShortByteString -> ShortByteString -> Ordering utf8CompareShortByteString (SBS a1) (SBS a2) = utf8CompareByteArray# a1 a2-------------------------------------------------------------- Everything below was moved into base in GHC 9.6------ These can be dropped in GHC 9.6 + 2 major releases.------------------------------------------------------------#if !MIN_VERSION_base(4,18,0)---- We can't write the decoder as efficiently as we'd like without--- resorting to unboxed extensions, unfortunately.  I tried to write--- an IO version of this function, but GHC can't eliminate boxed--- results from an IO-returning function.------ We assume we can ignore overflow when parsing a multibyte character here.--- To make this safe, we add extra sentinel bytes to unparsed UTF-8 sequences--- before decoding them (see "GHC.Data.StringBuffer").--{-# INLINE utf8DecodeChar# #-}--- | Decode a single codepoint from a byte buffer indexed by the given indexing--- function.-utf8DecodeChar# :: (Int# -> Word#) -> (# Char#, Int# #)-utf8DecodeChar# indexWord8# =-  let !ch0 = word2Int# (indexWord8# 0#) in-  case () of-    _ | isTrue# (ch0 <=# 0x7F#) -> (# chr# ch0, 1# #)--      | isTrue# ((ch0 >=# 0xC0#) `andI#` (ch0 <=# 0xDF#)) ->-        let !ch1 = word2Int# (indexWord8# 1#) in-        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else-        (# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +#-                  (ch1 -# 0x80#)),-           2# #)--      | isTrue# ((ch0 >=# 0xE0#) `andI#` (ch0 <=# 0xEF#)) ->-        let !ch1 = word2Int# (indexWord8# 1#) in-        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else-        let !ch2 = word2Int# (indexWord8# 2#) in-        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else-        (# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +#-                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#)  +#-                  (ch2 -# 0x80#)),-           3# #)--     | isTrue# ((ch0 >=# 0xF0#) `andI#` (ch0 <=# 0xF8#)) ->-        let !ch1 = word2Int# (indexWord8# 1#) in-        if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else-        let !ch2 = word2Int# (indexWord8# 2#) in-        if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else-        let !ch3 = word2Int# (indexWord8# 3#) in-        if isTrue# ((ch3 <# 0x80#) `orI#` (ch3 >=# 0xC0#)) then fail 3# else-        (# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +#-                 ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +#-                 ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#)  +#-                  (ch3 -# 0x80#)),-           4# #)--      | otherwise -> fail 1#-  where-        -- all invalid sequences end up here:-        fail :: Int# -> (# Char#, Int# #)-        fail nBytes# = (# '\0'#, nBytes# #)-        -- '\xFFFD' would be the usual replacement character, but-        -- that's a valid symbol in Haskell, so will result in a-        -- confusing parse error later on.  Instead we use '\0' which-        -- will signal a lexer error immediately.---- | Decode a single character at the given 'Addr#'.-utf8DecodeCharAddr# :: Addr# -> Int# -> (# Char#, Int# #)-utf8DecodeCharAddr# a# off# =-#if !MIN_VERSION_base(4,16,0)-    utf8DecodeChar# (\i# -> indexWord8OffAddr# a# (i# +# off#))-#else-    utf8DecodeChar# (\i# -> word8ToWord# (indexWord8OffAddr# a# (i# +# off#)))-#endif---- | Decode a single codepoint starting at the given 'Ptr'.-utf8DecodeCharPtr :: Ptr Word8 -> (Char, Int)-utf8DecodeCharPtr !(Ptr a#) =-  case utf8DecodeCharAddr# a# 0# of-    (# c#, nBytes# #) -> ( C# c#, I# nBytes# )---- | Decode a single codepoint starting at the given byte offset into a--- 'ByteArray#'.-utf8DecodeCharByteArray# :: ByteArray# -> Int# -> (# Char#, Int# #)-utf8DecodeCharByteArray# ba# off# =-#if !MIN_VERSION_base(4,16,0)-    utf8DecodeChar# (\i# -> indexWord8Array# ba# (i# +# off#))-#else-    utf8DecodeChar# (\i# -> word8ToWord# (indexWord8Array# ba# (i# +# off#)))-#endif--{-# INLINE utf8Decode# #-}-utf8Decode# :: (IO ()) -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]-utf8Decode# retain decodeChar# len#-  = unpack 0#-  where-    unpack i#-        | isTrue# (i# >=# len#) = retain >> return []-        | otherwise =-            case decodeChar# i# of-              (# c#, nBytes# #) -> do-                rest <- unsafeDupableInterleaveIO $ unpack (i# +# nBytes#)-                return (C# c# : rest)--utf8DecodeForeignPtr :: ForeignPtr Word8 -> Int -> Int -> [Char]-utf8DecodeForeignPtr fp offset (I# len#)-  = unsafeDupablePerformIO $ do-      let !(Ptr a#) = unsafeForeignPtrToPtr fp `plusPtr` offset-      utf8Decode# (touchForeignPtr fp) (utf8DecodeCharAddr# a#) len#--- Note that since utf8Decode# returns a thunk the lifetime of the--- ForeignPtr actually needs to be longer than the lexical lifetime--- withForeignPtr would provide here. That's why we use touchForeignPtr to--- keep the fp alive until the last character has actually been decoded.--utf8DecodeByteArray# :: ByteArray# -> [Char]-utf8DecodeByteArray# ba#-  = unsafeDupablePerformIO $-      let len# = sizeofByteArray# ba# in-      utf8Decode# (return ()) (utf8DecodeCharByteArray# ba#) len#--utf8CompareByteArray# :: ByteArray# -> ByteArray# -> Ordering-utf8CompareByteArray# a1 a2 = go 0# 0#-   -- UTF-8 has the property that sorting by bytes values also sorts by-   -- code-points.-   -- BUT we use "Modified UTF-8" which encodes \0 as 0xC080 so this property-   -- doesn't hold and we must explicitly check this case here.-   -- Note that decoding every code point would also work but it would be much-   -- more costly.-   where-       !sz1 = sizeofByteArray# a1-       !sz2 = sizeofByteArray# a2-       go off1 off2-         | isTrue# ((off1 >=# sz1) `andI#` (off2 >=# sz2)) = EQ-         | isTrue# (off1 >=# sz1)                          = LT-         | isTrue# (off2 >=# sz2)                          = GT-         | otherwise =-#if !MIN_VERSION_base(4,16,0)-               let !b1_1 = indexWord8Array# a1 off1-                   !b2_1 = indexWord8Array# a2 off2-#else-               let !b1_1 = word8ToWord# (indexWord8Array# a1 off1)-                   !b2_1 = word8ToWord# (indexWord8Array# a2 off2)-#endif-               in case b1_1 of-                  0xC0## -> case b2_1 of-                     0xC0## -> go (off1 +# 1#) (off2 +# 1#)-#if !MIN_VERSION_base(4,16,0)-                     _      -> case indexWord8Array# a1 (off1 +# 1#) of-#else-                     _      -> case word8ToWord# (indexWord8Array# a1 (off1 +# 1#)) of-#endif-                        0x80## -> LT-                        _      -> go (off1 +# 1#) (off2 +# 1#)-                  _      -> case b2_1 of-#if !MIN_VERSION_base(4,16,0)-                     0xC0## -> case indexWord8Array# a2 (off2 +# 1#) of-#else-                     0xC0## -> case word8ToWord# (indexWord8Array# a2 (off2 +# 1#)) of-#endif-                        0x80## -> GT-                        _      -> go (off1 +# 1#) (off2 +# 1#)-                     _   | isTrue# (b1_1 `gtWord#` b2_1) -> GT-                         | isTrue# (b1_1 `ltWord#` b2_1) -> LT-                         | otherwise                     -> go (off1 +# 1#) (off2 +# 1#)--utf8CountCharsByteArray# :: ByteArray# -> Int-utf8CountCharsByteArray# ba = go 0# 0#-  where-    len# = sizeofByteArray# ba-    go i# n#-      | isTrue# (i# >=# len#) = I# n#-      | otherwise =-          case utf8DecodeCharByteArray# ba i# of-            (# _, nBytes# #) -> go (i# +# nBytes#) (n# +# 1#)--{-# INLINE utf8EncodeChar #-}-utf8EncodeChar :: (Int# -> Word8# -> State# s -> State# s)-               -> Char -> ST s Int-utf8EncodeChar write# c =-  let x = fromIntegral (ord c) in-  case () of-    _ | x > 0 && x <= 0x007f -> do-          write 0 x-          return 1-        -- NB. '\0' is encoded as '\xC0\x80', not '\0'.  This is so that we-        -- can have 0-terminated UTF-8 strings (see GHC.Base.unpackCStringUtf8).-      | x <= 0x07ff -> do-          write 0 (0xC0 .|. ((x `shiftR` 6) .&. 0x1F))-          write 1 (0x80 .|. (x .&. 0x3F))-          return 2-      | x <= 0xffff -> do-          write 0 (0xE0 .|. (x `shiftR` 12) .&. 0x0F)-          write 1 (0x80 .|. (x `shiftR` 6) .&. 0x3F)-          write 2 (0x80 .|. (x .&. 0x3F))-          return 3-      | otherwise -> do-          write 0 (0xF0 .|. (x `shiftR` 18))-          write 1 (0x80 .|. ((x `shiftR` 12) .&. 0x3F))-          write 2 (0x80 .|. ((x `shiftR` 6) .&. 0x3F))-          write 3 (0x80 .|. (x .&. 0x3F))-          return 4-  where-    {-# INLINE write #-}-    write (I# off#) (W# c#) = ST $ \s ->-#if !MIN_VERSION_base(4,16,0)-      case write# off# (narrowWord8# c#) s of-#else-      case write# off# (wordToWord8# c#) s of-#endif-        s -> (# s, () #)--utf8EncodePtr :: Ptr Word8 -> String -> IO ()-utf8EncodePtr (Ptr a#) str = go a# str-  where go !_   []   = return ()-        go a# (c:cs) = do-#if !MIN_VERSION_base(4,16,0)-          -- writeWord8OffAddr# was taking a Word#-          I# off# <- stToIO $ utf8EncodeChar (\i w -> writeWord8OffAddr# a# i (extendWord8# w)) c-#else-          I# off# <- stToIO $ utf8EncodeChar (writeWord8OffAddr# a#) c-#endif-          go (a# `plusAddr#` off#) cs--utf8EncodeByteArray# :: String -> ByteArray#-utf8EncodeByteArray# str = runRW# $ \s ->-  case utf8EncodedLength str         of { I# len# ->-  case newByteArray# len# s          of { (# s, mba# #) ->-  case go mba# 0# str                of { ST f_go ->-  case f_go s                        of { (# s, () #) ->-  case unsafeFreezeByteArray# mba# s of { (# _, ba# #) ->-  ba# }}}}}-  where-    go _ _ [] = return ()-    go mba# i# (c:cs) = do-#if !MIN_VERSION_base(4,16,0)-      -- writeWord8Array# was taking a Word#-      I# off# <- utf8EncodeChar (\j# w -> writeWord8Array# mba# (i# +# j#) (extendWord8# w)) c-#else-      I# off# <- utf8EncodeChar (\j# -> writeWord8Array# mba# (i# +# j#)) c-#endif-      go mba# (i# +# off#) cs--utf8EncodedLength :: String -> Int-utf8EncodedLength str = go 0 str-  where go !n [] = n-        go n (c:cs)-          | ord c > 0 && ord c <= 0x007f = go (n+1) cs-          | ord c <= 0x07ff = go (n+2) cs-          | ord c <= 0xffff = go (n+3) cs-          | otherwise       = go (n+4) cs--#endif /* MIN_VERSION_base(4,18,0) */

@@ -5,7 +5,7 @@ -- ghc-boot.cabal.  name:           ghc-boot-version:        9.12.4+version:        9.14.1 license:        BSD-3-Clause license-file:   LICENSE category:       GHC@@ -75,10 +75,10 @@             GHC.Version             GHC.Platform.Host -    build-depends: base       >= 4.7 && < 4.22,+    build-depends: base       >= 4.7 && < 4.23,                    binary     == 0.8.*,                    bytestring >= 0.10 && < 0.13,-                   containers >= 0.5 && < 0.8,+                   containers >= 0.5 && < 0.9,                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.6,                    deepseq    >= 1.4 && < 1.6,@@ -94,10 +94,10 @@      if flag(bootstrap)       build-depends:-              ghc-boot-th-next    == 9.12.4+              ghc-boot-th-next    == 9.14.1     else       build-depends:-              ghc-boot-th         == 9.12.4+              ghc-boot-th         == 9.14.1      if !os(windows)         build-depends: