ghc-boot 9.0.1 → 9.2.1

raw patch · 13 files changed

+1045/−524 lines, 13 filesdep +deepseqdep ~basedep ~bytestringdep ~ghc-boot-thPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependency ranges changed: base, bytestring, ghc-boot-th

API changes (from Hackage documentation)

Files

• GHC/BaseDir.hs +1/−1
• GHC/Data/ShortText.hs +128/−0
• GHC/Data/SizedSeq.hs +48/−0
• GHC/Platform.hs +0/−362
• GHC/Platform/ArchOS.hs +157/−0
• GHC/Platform/Host.hs +7/−10
• GHC/Settings/Platform.hs +0/−99
• GHC/Settings/Utils.hs +57/−0
• GHC/UniqueSubdir.hs +5/−9
• GHC/Unit/Database.hs +34/−32
• GHC/Utils/Encoding.hs +585/−0
• GHC/Version.hs +3/−3
• ghc-boot.cabal +20/−8

@@ -16,7 +16,7 @@  import Prelude -- See Note [Why do we import Prelude here?] -import Data.List+import Data.List (stripPrefix) import System.FilePath  -- Windows

@@ -0,0 +1,128 @@+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, DerivingStrategies, CPP #-}+{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}+-- gross hack: we manuvered 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+-- don't have any prototypes and subsequently the llvm toolchain chokes on them.  Since 7fdcce6d, we use+-- ShortText for the package database.  This however introduces this very module; which through inlining ends+-- up bringing memcmp_ByteArray from bytestring:Data.ByteString.Short.Internal into scope, which results in+-- the memcmp call we choke on.+--+-- The solution thusly is to force late binding via the linker instead of inlining when comping with the+-- 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 soltuion.+--+-- 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 GHC_STAGE < 1+{-# 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+-- memory efficient data structure is desirable.++-- Very similar to FastString, but not hash-consed and with some extra instances and+-- functions for serialisation and I/O. Should be imported qualified.++module GHC.Data.ShortText (+        -- * ShortText+        ShortText(..),+        -- ** Conversion to and from String+        pack,+        unpack,+        -- ** Operations+        codepointLength,+        byteLength,+        GHC.Data.ShortText.null,+        splitFilePath,+        GHC.Data.ShortText.head,+        stripPrefix+  ) where++import Prelude++import Control.Monad (guard)+import Control.DeepSeq as DeepSeq+import Data.Binary+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Short.Internal as SBS+import GHC.Exts+import GHC.IO+import GHC.Utils.Encoding+import System.FilePath (isPathSeparator)++{-| A 'ShortText' is a modified UTF-8 encoded string meant for short strings like+file paths, module descriptions, etc.+-}+newtype ShortText = ShortText { contents :: SBS.ShortByteString+                              }+                              deriving stock (Show)+                              deriving newtype (Eq, Ord, Binary, Semigroup, Monoid, NFData)++-- We don't want to derive this one from ShortByteString since that one won't handle+-- UTF-8 characters correctly.+instance IsString ShortText where+  fromString = pack++-- | /O(n)/ Returns the length of the 'ShortText' in characters.+codepointLength :: ShortText -> Int+codepointLength st = unsafeDupablePerformIO $ countUTF8Chars (contents st)+-- | /O(1)/ Returns the length of the 'ShortText' in bytes.+byteLength :: ShortText -> Int+byteLength st = SBS.length $ contents st++-- | /O(n)/ Convert a 'String' into a 'ShortText'.+pack :: String -> ShortText+pack s = unsafeDupablePerformIO $ ShortText <$> utf8EncodeShortByteString s++-- | /O(n)/ Convert a 'ShortText' into a 'String'.+unpack :: ShortText -> String+unpack st = utf8DecodeShortByteString $ contents st++-- | /O(1)/ Test whether the 'ShortText' is the empty string.+null :: ShortText -> Bool+null st = SBS.null $ contents st++-- | /O(n)/ Split a 'ShortText' representing a file path into its components by separating+-- on the file separator characters for this platform.+splitFilePath :: ShortText -> [ShortText]+-- This seems dangerous, but since the path separators are in the ASCII set they map down+-- to a single byte when encoded in UTF-8 and so this should work even when casting to ByteString.+-- We DeepSeq.force the resulting list so that we can be sure that no references to the+-- bytestring in `st'` remain in unevaluated thunks, which might prevent `st'` from being+-- collected by the GC.+splitFilePath st = DeepSeq.force $ map (ShortText . SBS.toShort) $ B8.splitWith isPathSeparator st'+  where st' = SBS.fromShort $ contents st++-- | /O(1)/ Returns the first UTF-8 codepoint in the 'ShortText'. Depending on the string in+-- question, this may or may not be the actual first character in the string due to Unicode+-- non-printable characters.+head :: ShortText -> Char+head st+  | SBS.null $ contents st = error "head: Empty ShortText"+  | otherwise              = Prelude.head $ unpack st++-- | /O(n)/ The 'stripPrefix' function takes two 'ShortText's and returns 'Just' the remainder of+-- the second iff the first is its prefix, and otherwise Nothing.+stripPrefix :: ShortText -> ShortText -> Maybe ShortText+stripPrefix prefix st = do+  let !(SBS.SBS prefixBA) = contents prefix+  let !(SBS.SBS stBA)     = contents st+  let prefixLength        = sizeofByteArray# prefixBA+  let stLength            = sizeofByteArray# stBA+  -- If the length of 'st' is not >= than the length of 'prefix', it is impossible for 'prefix'+  -- to be the prefix of `st`.+  guard $ (I# stLength) >= (I# prefixLength)+  -- 'prefix' is a prefix of 'st' if the first <length of prefix> bytes of 'st'+  -- are equal to 'prefix'+  guard $ I# (compareByteArrays# prefixBA 0# stBA 0# prefixLength) == 0+  -- Allocate a new ByteArray# and copy the remainder of the 'st' into it+  unsafeDupablePerformIO $ do+    let newBAsize = (stLength -# prefixLength)+    newSBS <- IO $ \s0 ->+      let !(# s1, ba #)  = newByteArray# newBAsize s0+          s2             = copyByteArray# stBA prefixLength ba 0# newBAsize s1+          !(# s3, fba #) = unsafeFreezeByteArray# ba s2+      in  (# s3, SBS.SBS fba #)+    return . Just . ShortText $ newSBS

@@ -0,0 +1,48 @@+{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}+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 Data.List (genericLength)+import GHC.Generics++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 []++addToSS :: SizedSeq a -> a -> SizedSeq a+addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)++addListToSS :: SizedSeq a -> [a] -> SizedSeq a+addListToSS (SizedSeq n r_xs) xs+  = SizedSeq (n + genericLength xs) (reverse xs ++ r_xs)++ssElts :: SizedSeq a -> [a]+ssElts (SizedSeq _ r_xs) = reverse r_xs++sizeSS :: SizedSeq a -> Word+sizeSS (SizedSeq n _) = n

@@ -1,362 +0,0 @@-{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}---- | A description of the platform we're compiling for.----module GHC.Platform-   ( PlatformMini(..)-   , PlatformWordSize(..)-   , Platform(..)-   , platformArch-   , platformOS-   , Arch(..)-   , OS(..)-   , ArmISA(..)-   , ArmISAExt(..)-   , ArmABI(..)-   , PPC_64ABI(..)-   , ByteOrder(..)-   , target32Bit-   , isARM-   , osElfTarget-   , osMachOTarget-   , osSubsectionsViaSymbols-   , platformUsesFrameworks-   , platformWordSizeInBytes-   , platformWordSizeInBits-   , platformMinInt-   , platformMaxInt-   , platformMaxWord-   , platformInIntRange-   , platformInWordRange-   , platformCConvNeedsExtension-   , PlatformMisc(..)-   , stringEncodeArch-   , stringEncodeOS-   , SseVersion (..)-   , BmiVersion (..)-   )-where--import Prelude -- See Note [Why do we import Prelude here?]-import GHC.Read-import GHC.ByteOrder (ByteOrder(..))-import Data.Word-import Data.Int---- | Contains the bare-bones arch and os information. This isn't enough for--- code gen, but useful for tasks where we can fall back upon the host--- platform, as this is all we know about the host platform.-data PlatformMini-  = PlatformMini-    { platformMini_arch :: Arch-    , platformMini_os :: OS-    }-    deriving (Read, Show, Eq)---- | Contains enough information for the native code generator to emit--- code for this platform.-data Platform = Platform-   { platformMini                     :: !PlatformMini-   , platformWordSize                 :: !PlatformWordSize -- ^ Word size-   , platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)-   , platformUnregisterised           :: !Bool-   , platformHasGnuNonexecStack       :: !Bool-   , platformHasIdentDirective        :: !Bool-   , platformHasSubsectionsViaSymbols :: !Bool-   , platformIsCrossCompiling         :: !Bool-   , platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix-   , platformTablesNextToCode         :: !Bool-      -- ^ Determines whether we will be compiling info tables that reside just-      --   before the entry code, or with an indirection to the entry code. See-      --   TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.-   }-   deriving (Read, Show, Eq)--data PlatformWordSize-  = PW4 -- ^ A 32-bit platform-  | PW8 -- ^ A 64-bit platform-  deriving (Eq)--instance Show PlatformWordSize where-  show PW4 = "4"-  show PW8 = "8"--instance Read PlatformWordSize where-  readPrec = do-    i :: Int <- readPrec-    case i of-      4 -> return PW4-      8 -> return PW8-      other -> fail ("Invalid PlatformWordSize: " ++ show other)--platformWordSizeInBytes :: Platform -> Int-platformWordSizeInBytes p =-    case platformWordSize p of-      PW4 -> 4-      PW8 -> 8--platformWordSizeInBits :: Platform -> Int-platformWordSizeInBits p = platformWordSizeInBytes p * 8---- | Legacy accessor-platformArch :: Platform -> Arch-platformArch = platformMini_arch . platformMini---- | Legacy accessor-platformOS :: Platform -> OS-platformOS = platformMini_os . platformMini---- | Architectures that the native code generator knows about.---      TODO: It might be nice to extend these constructors with information---      about what instruction set extensions an architecture might support.----data Arch-        = ArchUnknown-        | ArchX86-        | ArchX86_64-        | ArchPPC-        | ArchPPC_64-          { ppc_64ABI :: PPC_64ABI-          }-        | ArchS390X-        | ArchSPARC-        | ArchSPARC64-        | ArchARM-          { armISA    :: ArmISA-          , armISAExt :: [ArmISAExt]-          , armABI    :: ArmABI-          }-        | ArchAArch64-        | ArchAlpha-        | ArchMipseb-        | ArchMipsel-        | ArchJavaScript-        deriving (Read, Show, Eq)---- Note [Platform Syntax]--- ~~~~~~~~~~~~~~~~~~~~~~--- There is a very loose encoding of platforms shared by many tools we are--- encoding to here. GNU Config (http://git.savannah.gnu.org/cgit/config.git),--- and LLVM's http://llvm.org/doxygen/classllvm_1_1Triple.html are perhaps the--- most definitional parsers. The basic syntax is a list of '-'-separated--- components. The Unix 'uname' command syntax is related but briefer.------ Those two parsers are quite forgiving, and even the 'config.sub'--- normalization is forgiving too. The "best" way to encode a platform is--- therefore somewhat a matter of taste.------ The 'stringEncode*' functions here convert each part of GHC's structured--- notion of a platform into one dash-separated component.---- | See Note [Platform Syntax].-stringEncodeArch :: Arch -> String-stringEncodeArch = \case-  ArchUnknown -> "unknown"-  ArchX86 -> "i386"-  ArchX86_64 -> "x86_64"-  ArchPPC -> "powerpc"-  ArchPPC_64 { ppc_64ABI = abi } -> case abi of-    ELF_V1 -> "powerpc64"-    ELF_V2 -> "powerpc64le"-  ArchS390X -> "s390x"-  ArchSPARC -> "sparc"-  ArchSPARC64 -> "sparc64"-  ArchARM { armISA = isa, armISAExt = _, armABI = _ } -> "arm" ++ vsuf-    where-      vsuf = case isa of-        ARMv5 -> "v5"-        ARMv6 -> "v6"-        ARMv7 -> "v7"-  ArchAArch64 -> "aarch64"-  ArchAlpha -> "alpha"-  ArchMipseb -> "mipseb"-  ArchMipsel -> "mipsel"-  ArchJavaScript -> "js"--isARM :: Arch -> Bool-isARM (ArchARM {}) = True-isARM ArchAArch64  = True-isARM _ = False---- | Operating systems that the native code generator knows about.---      Having OSUnknown should produce a sensible default, but no promises.-data OS-        = OSUnknown-        | OSLinux-        | OSDarwin-        | OSSolaris2-        | OSMinGW32-        | OSFreeBSD-        | OSDragonFly-        | OSOpenBSD-        | OSNetBSD-        | OSKFreeBSD-        | OSHaiku-        | OSQNXNTO-        | OSAIX-        | OSHurd-        deriving (Read, Show, Eq)---- | See Note [Platform Syntax].-stringEncodeOS :: OS -> String-stringEncodeOS = \case-  OSUnknown -> "unknown"-  OSLinux -> "linux"-  OSDarwin -> "darwin"-  OSSolaris2 -> "solaris2"-  OSMinGW32 -> "mingw32"-  OSFreeBSD -> "freebsd"-  OSDragonFly -> "dragonfly"-  OSOpenBSD -> "openbsd"-  OSNetBSD -> "netbsd"-  OSKFreeBSD -> "kfreebsdgnu"-  OSHaiku -> "haiku"-  OSQNXNTO -> "nto-qnx"-  OSAIX -> "aix"-  OSHurd -> "hurd"---- | ARM Instruction Set Architecture, Extensions and ABI----data ArmISA-    = ARMv5-    | ARMv6-    | ARMv7-    deriving (Read, Show, Eq)--data ArmISAExt-    = VFPv2-    | VFPv3-    | VFPv3D16-    | NEON-    | IWMMX2-    deriving (Read, Show, Eq)--data ArmABI-    = SOFT-    | SOFTFP-    | HARD-    deriving (Read, Show, Eq)---- | PowerPC 64-bit ABI----data PPC_64ABI-    = ELF_V1-    | ELF_V2-    deriving (Read, Show, Eq)---- | This predicate tells us whether the platform is 32-bit.-target32Bit :: Platform -> Bool-target32Bit p =-    case platformWordSize p of-      PW4 -> True-      PW8 -> False---- | This predicate tells us whether the OS supports ELF-like shared libraries.-osElfTarget :: OS -> Bool-osElfTarget OSLinux     = True-osElfTarget OSFreeBSD   = True-osElfTarget OSDragonFly = True-osElfTarget OSOpenBSD   = True-osElfTarget OSNetBSD    = True-osElfTarget OSSolaris2  = True-osElfTarget OSDarwin    = False-osElfTarget OSMinGW32   = False-osElfTarget OSKFreeBSD  = True-osElfTarget OSHaiku     = True-osElfTarget OSQNXNTO    = False-osElfTarget OSAIX       = False-osElfTarget OSHurd      = True-osElfTarget OSUnknown   = False- -- Defaulting to False is safe; it means don't rely on any- -- ELF-specific functionality.  It is important to have a default for- -- portability, otherwise we have to answer this question for every- -- new platform we compile on (even unreg).---- | This predicate tells us whether the OS support Mach-O shared libraries.-osMachOTarget :: OS -> Bool-osMachOTarget OSDarwin = True-osMachOTarget _ = False--osUsesFrameworks :: OS -> Bool-osUsesFrameworks OSDarwin = True-osUsesFrameworks _        = False--platformUsesFrameworks :: Platform -> Bool-platformUsesFrameworks = osUsesFrameworks . platformOS--osSubsectionsViaSymbols :: OS -> Bool-osSubsectionsViaSymbols OSDarwin = True-osSubsectionsViaSymbols _        = False---- | Platform-specific settings formerly hard-coded in Config.hs.------ These should probably be all be triaged whether they can be computed from--- other settings or belong in another another place (like 'Platform' above).-data PlatformMisc = PlatformMisc-  { -- TODO Recalculate string from richer info?-    platformMisc_targetPlatformString :: String-  , platformMisc_ghcWithInterpreter   :: Bool-  , platformMisc_ghcWithSMP           :: Bool-  , platformMisc_ghcRTSWays           :: String-  , platformMisc_libFFI               :: Bool-  , platformMisc_ghcThreaded          :: Bool-  , platformMisc_ghcDebugged          :: Bool-  , platformMisc_ghcRtsWithLibdw      :: Bool-  , platformMisc_llvmTarget           :: String-  }---- | Minimum representable Int value for the given platform-platformMinInt :: Platform -> Integer-platformMinInt p = case platformWordSize p of-   PW4 -> toInteger (minBound :: Int32)-   PW8 -> toInteger (minBound :: Int64)---- | Maximum representable Int value for the given platform-platformMaxInt :: Platform -> Integer-platformMaxInt p = case platformWordSize p of-   PW4 -> toInteger (maxBound :: Int32)-   PW8 -> toInteger (maxBound :: Int64)---- | Maximum representable Word value for the given platform-platformMaxWord :: Platform -> Integer-platformMaxWord p = case platformWordSize p of-   PW4 -> toInteger (maxBound :: Word32)-   PW8 -> toInteger (maxBound :: Word64)---- | Test if the given Integer is representable with a platform Int-platformInIntRange :: Platform -> Integer -> Bool-platformInIntRange platform x = x >= platformMinInt platform && x <= platformMaxInt platform---- | Test if the given Integer is representable with a platform Word-platformInWordRange :: Platform -> Integer -> Bool-platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform---- | For some architectures the C calling convention is that any--- integer shorter than 64 bits is replaced by its 64 bits--- representation using sign or zero extension.-platformCConvNeedsExtension :: Platform -> Bool-platformCConvNeedsExtension platform = case platformArch platform of-  ArchPPC_64 _ -> True-  ArchS390X    -> True-  _            -> False-------------------------------------------------------- Instruction sets------------------------------------------------------- | x86 SSE instructions-data SseVersion-   = SSE1-   | SSE2-   | SSE3-   | SSE4-   | SSE42-   deriving (Eq, Ord)---- | x86 BMI (bit manipulation) instructions-data BmiVersion-   = BMI1-   | BMI2-   deriving (Eq, Ord)-

@@ -0,0 +1,157 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}++-- | Platform architecture and OS+--+-- We need it in ghc-boot because ghc-pkg needs it.+module GHC.Platform.ArchOS+   ( ArchOS(..)+   , Arch(..)+   , OS(..)+   , ArmISA(..)+   , ArmISAExt(..)+   , ArmABI(..)+   , PPC_64ABI(..)+   , stringEncodeArch+   , stringEncodeOS+   )+where++import Prelude -- See Note [Why do we import Prelude here?]++-- | Platform architecture and OS.+data ArchOS+   = ArchOS+      { archOS_arch :: Arch+      , archOS_OS   :: OS+      }+   deriving (Read, Show, Eq)++-- | Architectures+--+-- TODO: It might be nice to extend these constructors with information about+-- what instruction set extensions an architecture might support.+--+data Arch+   = ArchUnknown+   | ArchX86+   | ArchX86_64+   | ArchPPC+   | ArchPPC_64 PPC_64ABI+   | ArchS390X+   | ArchSPARC+   | ArchSPARC64+   | ArchARM ArmISA [ArmISAExt] ArmABI+   | ArchAArch64+   | ArchAlpha+   | ArchMipseb+   | ArchMipsel+   | ArchRISCV64+   | ArchJavaScript+   deriving (Read, Show, Eq)++-- | ARM Instruction Set Architecture+data ArmISA+   = ARMv5+   | ARMv6+   | ARMv7+   deriving (Read, Show, Eq)++-- | ARM extensions+data ArmISAExt+   = VFPv2+   | VFPv3+   | VFPv3D16+   | NEON+   | IWMMX2+   deriving (Read, Show, Eq)++-- | ARM ABI+data ArmABI+   = SOFT+   | SOFTFP+   | HARD+   deriving (Read, Show, Eq)++-- | PowerPC 64-bit ABI+data PPC_64ABI+   = ELF_V1 -- ^ PowerPC64+   | ELF_V2 -- ^ PowerPC64 LE+   deriving (Read, Show, Eq)++-- | Operating systems.+--+-- Using OSUnknown to generate code should produce a sensible default, but no+-- promises.+data OS+   = OSUnknown+   | OSLinux+   | OSDarwin+   | OSSolaris2+   | OSMinGW32+   | OSFreeBSD+   | OSDragonFly+   | OSOpenBSD+   | OSNetBSD+   | OSKFreeBSD+   | OSHaiku+   | OSQNXNTO+   | OSAIX+   | OSHurd+   deriving (Read, Show, Eq)+++-- Note [Platform Syntax]+-- ~~~~~~~~~~~~~~~~~~~~~~+--+-- There is a very loose encoding of platforms shared by many tools we are+-- encoding to here. GNU Config (http://git.savannah.gnu.org/cgit/config.git),+-- and LLVM's http://llvm.org/doxygen/classllvm_1_1Triple.html are perhaps the+-- most definitional parsers. The basic syntax is a list of '-'-separated+-- components. The Unix 'uname' command syntax is related but briefer.+--+-- Those two parsers are quite forgiving, and even the 'config.sub'+-- normalization is forgiving too. The "best" way to encode a platform is+-- therefore somewhat a matter of taste.+--+-- The 'stringEncode*' functions here convert each part of GHC's structured+-- notion of a platform into one dash-separated component.++-- | See Note [Platform Syntax].+stringEncodeArch :: Arch -> String+stringEncodeArch = \case+  ArchUnknown       -> "unknown"+  ArchX86           -> "i386"+  ArchX86_64        -> "x86_64"+  ArchPPC           -> "powerpc"+  ArchPPC_64 ELF_V1 -> "powerpc64"+  ArchPPC_64 ELF_V2 -> "powerpc64le"+  ArchS390X         -> "s390x"+  ArchSPARC         -> "sparc"+  ArchSPARC64       -> "sparc64"+  ArchARM ARMv5 _ _ -> "armv5"+  ArchARM ARMv6 _ _ -> "armv6"+  ArchARM ARMv7 _ _ -> "armv7"+  ArchAArch64       -> "aarch64"+  ArchAlpha         -> "alpha"+  ArchMipseb        -> "mipseb"+  ArchMipsel        -> "mipsel"+  ArchRISCV64       -> "riscv64"+  ArchJavaScript    -> "js"++-- | See Note [Platform Syntax].+stringEncodeOS :: OS -> String+stringEncodeOS = \case+  OSUnknown   -> "unknown"+  OSLinux     -> "linux"+  OSDarwin    -> "darwin"+  OSSolaris2  -> "solaris2"+  OSMinGW32   -> "mingw32"+  OSFreeBSD   -> "freebsd"+  OSDragonFly -> "dragonfly"+  OSOpenBSD   -> "openbsd"+  OSNetBSD    -> "netbsd"+  OSKFreeBSD  -> "kfreebsdgnu"+  OSHaiku     -> "haiku"+  OSQNXNTO    -> "nto-qnx"+  OSAIX       -> "aix"+  OSHurd      -> "hurd"

@@ -1,15 +1,12 @@ module GHC.Platform.Host where -import GHC.Platform+import GHC.Platform.ArchOS -cHostPlatformArch :: Arch-cHostPlatformArch = ArchX86_64+hostPlatformArch :: Arch+hostPlatformArch = ArchX86_64 -cHostPlatformOS   :: OS-cHostPlatformOS   = OSLinux+hostPlatformOS   :: OS+hostPlatformOS   = OSLinux -cHostPlatformMini :: PlatformMini-cHostPlatformMini = PlatformMini-  { platformMini_arch = cHostPlatformArch-  , platformMini_os = cHostPlatformOS-  }+hostPlatformArchOS :: ArchOS+hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS

@@ -1,99 +0,0 @@--- Note [Settings file]--- ~~~~~~~~~~~~~~~~~~~~------ GHC has a file, `${top_dir}/settings`, which is the main source of run-time--- configuration. ghc-pkg needs just a little bit of it: the target platform CPU--- arch and OS. It uses that to figure out what subdirectory of `~/.ghc` is--- associated with the current version/target.------ This module has just enough code to read key value pairs from the settings--- file, and read the target platform from those pairs.------ The  "0" suffix is because the caller will partially apply it, and that will--- in turn be used a few more times.-module GHC.Settings.Platform where--import Prelude -- See Note [Why do we import Prelude here?]--import GHC.BaseDir-import GHC.Platform-import GHC.Settings.Utils--import Data.Map (Map)-import qualified Data.Map as Map---------------------------------------------------------------------------------- parts of settings file--getTargetPlatform-  :: FilePath -> RawSettings -> Either String Platform-getTargetPlatform settingsFile mySettings = do-  let-    getBooleanSetting = getBooleanSetting0 settingsFile mySettings-    readSetting :: (Show a, Read a) => String -> Either String a-    readSetting = readSetting0 settingsFile mySettings--  targetArch <- readSetting "target arch"-  targetOS <- readSetting "target os"-  targetWordSize <- readSetting "target word size"-  targetWordBigEndian <- getBooleanSetting "target word big endian"-  targetLeadingUnderscore <- getBooleanSetting "Leading underscore"-  targetUnregisterised <- getBooleanSetting "Unregisterised"-  targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack"-  targetHasIdentDirective <- getBooleanSetting "target has .ident directive"-  targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols"-  crossCompiling <- getBooleanSetting "cross compiling"-  tablesNextToCode <- getBooleanSetting "Tables next to code"--  pure $ Platform-    { platformMini = PlatformMini-      { platformMini_arch = targetArch-      , platformMini_os = targetOS-      }-    , platformWordSize = targetWordSize-    , platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian-    , platformUnregisterised = targetUnregisterised-    , platformHasGnuNonexecStack = targetHasGnuNonexecStack-    , platformHasIdentDirective = targetHasIdentDirective-    , platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols-    , platformIsCrossCompiling = crossCompiling-    , platformLeadingUnderscore = targetLeadingUnderscore-    , platformTablesNextToCode  = tablesNextToCode-    }---------------------------------------------------------------------------------- settings file helpers--type RawSettings = Map String String---- | See Note [Settings file] for "0" suffix-getSetting0-  :: FilePath -> RawSettings -> String -> Either String String-getSetting0 settingsFile mySettings key = case Map.lookup key mySettings of-  Just xs -> Right xs-  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile---- | See Note [Settings file] for "0" suffix-getFilePathSetting0-  :: FilePath -> FilePath -> RawSettings -> String -> Either String String-getFilePathSetting0 top_dir settingsFile mySettings key =-  expandTopDir top_dir <$> getSetting0 settingsFile mySettings key---- | See Note [Settings file] for "0" suffix-getBooleanSetting0-  :: FilePath -> RawSettings -> String -> Either String Bool-getBooleanSetting0 settingsFile mySettings key = do-  rawValue <- getSetting0 settingsFile mySettings key-  case rawValue of-    "YES" -> Right True-    "NO" -> Right False-    xs -> Left $ "Bad value for " ++ show key ++ ": " ++ show xs---- | See Note [Settings file] for "0" suffix-readSetting0-  :: (Show a, Read a) => FilePath -> RawSettings -> String -> Either String a-readSetting0 settingsFile mySettings key = case Map.lookup key mySettings of-  Just xs -> case maybeRead xs of-    Just v -> Right v-    Nothing -> Left $ "Failed to read " ++ show key ++ " value " ++ show xs-  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile

@@ -3,7 +3,12 @@ import Prelude -- See Note [Why do we import Prelude here?]  import Data.Char (isSpace)+import Data.Map (Map)+import qualified Data.Map as Map +import GHC.BaseDir+import GHC.Platform.ArchOS+ maybeRead :: Read a => String -> Maybe a maybeRead str = case reads str of   [(x, "")] -> Just x@@ -13,3 +18,55 @@ maybeReadFuzzy str = case reads str of   [(x, s)] | all isSpace s -> Just x   _ -> Nothing+++-- Note [Settings file]+-- ~~~~~~~~~~~~~~~~~~~~+--+-- GHC has a file, `${top_dir}/settings`, which is the main source of run-time+-- configuration. ghc-pkg needs just a little bit of it: the target platform CPU+-- arch and OS. It uses that to figure out what subdirectory of `~/.ghc` is+-- associated with the current version/target platform.+--+-- This module has just enough code to read key value pairs from the settings+-- file, and read the target platform from those pairs.++type RawSettings = Map String String++-- | Read target Arch/OS from the settings+getTargetArchOS+  :: FilePath     -- ^ Settings filepath (for error messages)+  -> RawSettings  -- ^ Raw settings file contents+  -> Either String ArchOS+getTargetArchOS settingsFile settings =+  ArchOS <$> readRawSetting settingsFile settings "target arch"+         <*> readRawSetting settingsFile settings "target os"+++getRawSetting+  :: FilePath -> RawSettings -> String -> Either String String+getRawSetting settingsFile settings key = case Map.lookup key settings of+  Just xs -> Right xs+  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile++getRawFilePathSetting+  :: FilePath -> FilePath -> RawSettings -> String -> Either String String+getRawFilePathSetting top_dir settingsFile settings key =+  expandTopDir top_dir <$> getRawSetting settingsFile settings key++getRawBooleanSetting+  :: FilePath -> RawSettings -> String -> Either String Bool+getRawBooleanSetting settingsFile settings key = do+  rawValue <- getRawSetting settingsFile settings key+  case rawValue of+    "YES" -> Right True+    "NO" -> Right False+    xs -> Left $ "Bad value for " ++ show key ++ ": " ++ show xs++readRawSetting+  :: (Show a, Read a) => FilePath -> RawSettings -> String -> Either String a+readRawSetting settingsFile settings key = case Map.lookup key settings of+  Just xs -> case maybeRead xs of+    Just v -> Right v+    Nothing -> Left $ "Failed to read " ++ show key ++ " value " ++ show xs+  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile

@@ -6,19 +6,15 @@  import Data.List (intercalate) -import GHC.Platform+import GHC.Platform.ArchOS import GHC.Version (cProjectVersion)  -- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when -- constructing platform-version-dependent files that need to co-exist.------ 'ghc-pkg' falls back on the host platform if the settings file is missing,--- and so needs this since we don't have information about the host platform in--- as much detail as 'Platform', so we use 'PlatformMini' instead.-uniqueSubdir :: PlatformMini -> FilePath-uniqueSubdir archOs = intercalate "-"-  [ stringEncodeArch $ platformMini_arch archOs-  , stringEncodeOS $ platformMini_os archOs+uniqueSubdir :: ArchOS -> FilePath+uniqueSubdir (ArchOS arch os) = intercalate "-"+  [ stringEncodeArch arch+  , stringEncodeOS os   , cProjectVersion   ]   -- NB: This functionality is reimplemented in Cabal, so if you

@@ -12,6 +12,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}  ----------------------------------------------------------------------------- -- |@@ -82,16 +83,16 @@ import Data.Binary as Bin import Data.Binary.Put as Bin import Data.Binary.Get as Bin+import Data.List (intersperse) import Control.Exception as Exception import Control.Monad (when) import System.FilePath as FilePath-import qualified System.FilePath.Posix as FilePath.Posix import System.IO import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType))+import qualified GHC.Data.ShortText as ST import GHC.IO.Handle.Lock import System.Directory-import Data.List (stripPrefix)  -- | @ghc-boot@'s UnitInfo, serialized to the database. type DbUnitInfo      = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule@@ -142,28 +143,28 @@       -- components that can be registered in a database and used by other       -- modules. -   , unitAbiHash        :: String+   , unitAbiHash        :: ST.ShortText       -- ^ ABI hash used to avoid mixing up units compiled with different       -- dependencies, compiler, options, etc.     , unitDepends        :: [uid]       -- ^ Identifiers of the units this one depends on -   , unitAbiDepends     :: [(uid, String)]+   , unitAbiDepends     :: [(uid, ST.ShortText)]      -- ^ Like 'unitDepends', but each dependency is annotated with the ABI hash      -- we expect the dependency to respect. -   , unitImportDirs     :: [FilePath]+   , unitImportDirs     :: [FilePathST]       -- ^ Directories containing module interfaces -   , unitLibraries      :: [String]+   , unitLibraries      :: [ST.ShortText]       -- ^ Names of the Haskell libraries provided by this unit -   , unitExtDepLibsSys  :: [String]+   , unitExtDepLibsSys  :: [ST.ShortText]       -- ^ Names of the external system libraries that this unit depends on. See       -- also `unitExtDepLibsGhc` field. -   , unitExtDepLibsGhc  :: [String]+   , unitExtDepLibsGhc  :: [ST.ShortText]       -- ^ Because of slight differences between the GHC dynamic linker (in       -- GHC.Runtime.Linker) and the       -- native system linker, some packages have to link with a different list@@ -174,46 +175,46 @@       -- If this field is set, then we use that instead of the       -- `unitExtDepLibsSys` field. -   , unitLibraryDirs    :: [FilePath]+   , unitLibraryDirs    :: [FilePathST]       -- ^ Directories containing libraries provided by this unit. See also       -- `unitLibraryDynDirs`.       --       -- It seems to be used to store paths to external library dependencies       -- too. -   , unitLibraryDynDirs :: [FilePath]+   , unitLibraryDynDirs :: [FilePathST]       -- ^ Directories containing the dynamic libraries provided by this unit.       -- See also `unitLibraryDirs`.       --       -- It seems to be used to store paths to external dynamic library       -- dependencies too. -   , unitExtDepFrameworks :: [String]+   , unitExtDepFrameworks :: [ST.ShortText]       -- ^ Names of the external MacOS frameworks that this unit depends on. -   , unitExtDepFrameworkDirs :: [FilePath]+   , unitExtDepFrameworkDirs :: [FilePathST]       -- ^ Directories containing MacOS frameworks that this unit depends       -- on. -   , unitLinkerOptions  :: [String]+   , unitLinkerOptions  :: [ST.ShortText]       -- ^ Linker (e.g. ld) command line options -   , unitCcOptions      :: [String]+   , unitCcOptions      :: [ST.ShortText]       -- ^ C compiler options that needs to be passed to the C compiler when we       -- compile some C code against this unit. -   , unitIncludes       :: [String]+   , unitIncludes       :: [ST.ShortText]       -- ^ C header files that are required by this unit (provided by this unit       -- or external) -   , unitIncludeDirs    :: [FilePath]+   , unitIncludeDirs    :: [FilePathST]       -- ^ Directories containing C header files that this unit depends       -- on. -   , unitHaddockInterfaces :: [FilePath]+   , unitHaddockInterfaces :: [FilePathST]       -- ^ Paths to Haddock interface files for this unit -   , unitHaddockHTMLs   :: [FilePath]+   , unitHaddockHTMLs   :: [FilePathST]       -- ^ Paths to Haddock directories containing HTML files     , unitExposedModules :: [(modulename, Maybe mod)]@@ -242,6 +243,8 @@    }    deriving (Eq, Show) +type FilePathST = ST.ShortText+ -- | Convert between GenericUnitInfo instances mapGenericUnitInfo    :: (uid1 -> uid2)@@ -646,12 +649,12 @@ -- Also perform a similar substitution for the older GHC-specific -- "$topdir" variable. The "topdir" is the location of the ghc -- installation (obtained from the -B option).-mkMungePathUrl :: FilePath -> FilePath -> (FilePath -> FilePath, FilePath -> FilePath)+mkMungePathUrl :: FilePathST -> FilePathST -> (FilePathST -> FilePathST, FilePathST -> FilePathST) mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)    where     munge_path p-      | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'-      | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'+      | Just p' <- stripVarPrefix "${pkgroot}" p = mappend pkgroot p'+      | Just p' <- stripVarPrefix "$topdir"    p = mappend top_dir p'       | otherwise                                = p      munge_url p@@ -659,20 +662,19 @@       | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'       | otherwise                                   = p -    toUrlPath r p = "file:///"-                 -- URLs always use posix style '/' separators:-                 ++ FilePath.Posix.joinPath-                        (r : -- We need to drop a leading "/" or "\\"-                             -- if there is one:-                             dropWhile (all isPathSeparator)-                                       (FilePath.splitDirectories p))+    toUrlPath r p = mconcat $ "file:///" : (intersperse "/" (r : (splitDirectories p)))+                                          -- URLs always use posix style '/' separators +    -- We need to drop a leading "/" or "\\" if there is one:+    splitDirectories :: FilePathST -> [FilePathST]+    splitDirectories p  = filter (not . ST.null) $ ST.splitFilePath p+     -- We could drop the separator here, and then use </> above. However,     -- by leaving it in and using ++ we keep the same path separator     -- rather than letting FilePath change it to use \ as the separator-    stripVarPrefix var path = case stripPrefix var path of-                              Just [] -> Just []-                              Just cs@(c : _) | isPathSeparator c -> Just cs+    stripVarPrefix var path = case ST.stripPrefix var path of+                              Just "" -> Just ""+                              Just cs | isPathSeparator (ST.head cs) -> Just cs                               _ -> Nothing  @@ -684,7 +686,7 @@ -- Also perform a similar substitution for the older GHC-specific -- "$topdir" variable. The "topdir" is the location of the ghc -- installation (obtained from the -B option).-mungeUnitInfoPaths :: FilePath -> FilePath -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f+mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f mungeUnitInfoPaths top_dir pkgroot pkg =    -- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs     pkg

@@ -0,0 +1,585 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -O2 -fno-warn-name-shadowing #-}+-- We always optimise this, otherwise performance of a non-optimised+-- compiler is severely affected. This module used to live in the `ghc`+-- package but has been moved to `ghc-boot` because the definition+-- of the package database (needed in both ghc and in ghc-pkg) lives in+-- `ghc-boot` and uses ShortText, which in turn depends on this module.++-- -----------------------------------------------------------------------------+--+-- (c) The University of Glasgow, 1997-2006+--+-- Character encodings+--+-- -----------------------------------------------------------------------------++module GHC.Utils.Encoding (+        -- * UTF-8+        utf8DecodeCharAddr#,+        utf8PrevChar,+        utf8CharStart,+        utf8DecodeChar,+        utf8DecodeByteString,+        utf8UnconsByteString,+        utf8DecodeShortByteString,+        utf8CompareShortByteString,+        utf8DecodeStringLazy,+        utf8EncodeChar,+        utf8EncodeString,+        utf8EncodeStringPtr,+        utf8EncodeShortByteString,+        utf8EncodedLength,+        countUTF8Chars,++        -- * Z-encoding+        zEncodeString,+        zDecodeString,++        -- * Base62-encoding+        toBase62,+        toBase62Padded+  ) where++import Prelude++import Foreign+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Data.Char+import qualified Data.Char as Char+import Numeric+import GHC.IO+import GHC.ST++import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS+import Data.ByteString.Short.Internal (ShortByteString(..))++import GHC.Exts++-- -----------------------------------------------------------------------------+-- UTF-8++-- 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# #-}+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.++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++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+++utf8DecodeChar :: Ptr Word8 -> (Char, Int)+utf8DecodeChar !(Ptr a#) =+  case utf8DecodeCharAddr# a# 0# of+    (# c#, nBytes# #) -> ( C# c#, I# nBytes# )++-- UTF-8 is cleverly designed so that we can always figure out where+-- the start of the current character is, given any position in a+-- stream.  This function finds the start of the previous character,+-- assuming there *is* a previous character.+utf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)+utf8PrevChar p = utf8CharStart (p `plusPtr` (-1))++utf8CharStart :: Ptr Word8 -> IO (Ptr Word8)+utf8CharStart p = go p+ where go p = do w <- peek p+                 if w >= 0x80 && w < 0xC0+                        then go (p `plusPtr` (-1))+                        else return p++{-# INLINE utf8DecodeLazy# #-}+utf8DecodeLazy# :: (IO ()) -> (Int# -> (# Char#, Int# #)) -> Int# -> IO [Char]+utf8DecodeLazy# 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)++utf8DecodeByteString :: ByteString -> [Char]+utf8DecodeByteString (BS.PS fptr offset len)+  = utf8DecodeStringLazy fptr offset len++utf8UnconsByteString :: ByteString -> Maybe (Char, ByteString)+utf8UnconsByteString (BS.PS _ _ 0) = Nothing+utf8UnconsByteString (BS.PS fptr offset len)+  = unsafeDupablePerformIO $+      withForeignPtr fptr $ \ptr -> do+        let (c,n) = utf8DecodeChar (ptr `plusPtr` offset)+        return $ Just (c, BS.PS fptr (offset + n) (len - n))++utf8DecodeStringLazy :: ForeignPtr Word8 -> Int -> Int -> [Char]+utf8DecodeStringLazy fp offset (I# len#)+  = unsafeDupablePerformIO $ do+      let !(Ptr a#) = unsafeForeignPtrToPtr fp `plusPtr` offset+      utf8DecodeLazy# (touchForeignPtr fp) (utf8DecodeCharAddr# a#) len#+-- Note that since utf8DecodeLazy# 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.++utf8CompareShortByteString :: ShortByteString -> ShortByteString -> Ordering+utf8CompareShortByteString (SBS a1) (SBS 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#)++utf8DecodeShortByteString :: ShortByteString -> [Char]+utf8DecodeShortByteString (SBS ba#)+  = unsafeDupablePerformIO $+      let len# = sizeofByteArray# ba# in+      utf8DecodeLazy# (return ()) (utf8DecodeCharByteArray# ba#) len#++countUTF8Chars :: ShortByteString -> IO Int+countUTF8Chars (SBS ba) = go 0# 0#+  where+    len# = sizeofByteArray# ba+    go i# n#+      | isTrue# (i# >=# len#) =+          return (I# n#)+      | otherwise = do+          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, () #)++utf8EncodeString :: String -> ByteString+utf8EncodeString s =+  unsafePerformIO $ do+    let len = utf8EncodedLength s+    buf <- mallocForeignPtrBytes len+    withForeignPtr buf $ \ptr -> do+      utf8EncodeStringPtr ptr s+      pure (BS.fromForeignPtr buf 0 len)++utf8EncodeStringPtr :: Ptr Word8 -> String -> IO ()+utf8EncodeStringPtr (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++utf8EncodeShortByteString :: String -> IO ShortByteString+utf8EncodeShortByteString str = IO $ \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 { (# s, ba# #) ->+  (# s, SBS 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++-- -----------------------------------------------------------------------------+-- Note [Z-Encoding]+-- ~~~~~~~~~~~~~~~~~++{-+This is the main name-encoding and decoding function.  It encodes any+string into a string that is acceptable as a C name.  This is done+right before we emit a symbol name into the compiled C or asm code.+Z-encoding of strings is cached in the FastString interface, so we+never encode the same string more than once.++The basic encoding scheme is this.++* Tuples (,,,) are coded as Z3T++* Alphabetic characters (upper and lower) and digits+        all translate to themselves;+        except 'Z', which translates to 'ZZ'+        and    'z', which translates to 'zz'+  We need both so that we can preserve the variable/tycon distinction++* Most other printable characters translate to 'zx' or 'Zx' for some+        alphabetic character x++* The others translate as 'znnnU' where 'nnn' is the decimal number+        of the character++        Before          After+        --------------------------+        Trak            Trak+        foo_wib         foozuwib+        >               zg+        >1              zg1+        foo#            foozh+        foo##           foozhzh+        foo##1          foozhzh1+        fooZ            fooZZ+        :+              ZCzp+        ()              Z0T     0-tuple+        (,,,,)          Z5T     5-tuple+        (# #)           Z1H     unboxed 1-tuple (note the space)+        (#,,,,#)        Z5H     unboxed 5-tuple+                (NB: There is no Z1T nor Z0H.)+-}++type UserString = String        -- As the user typed it+type EncodedString = String     -- Encoded form+++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++unencodedChar :: Char -> Bool   -- True for chars that don't need encoding+unencodedChar 'Z' = False+unencodedChar 'z' = False+unencodedChar c   =  c >= 'a' && c <= 'z'+                  || 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++-- Constructors+encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)+encode_ch ')'  = "ZR"   -- For symmetry with (+encode_ch '['  = "ZM"+encode_ch ']'  = "ZN"+encode_ch ':'  = "ZC"+encode_ch 'Z'  = "ZZ"++-- Variables+encode_ch 'z'  = "zz"+encode_ch '&'  = "za"+encode_ch '|'  = "zb"+encode_ch '^'  = "zc"+encode_ch '$'  = "zd"+encode_ch '='  = "ze"+encode_ch '>'  = "zg"+encode_ch '#'  = "zh"+encode_ch '.'  = "zi"+encode_ch '<'  = "zl"+encode_ch '-'  = "zm"+encode_ch '!'  = "zn"+encode_ch '+'  = "zp"+encode_ch '\'' = "zq"+encode_ch '\\' = "zr"+encode_ch '/'  = "zs"+encode_ch '*'  = "zt"+encode_ch '_'  = "zu"+encode_ch '%'  = "zv"+encode_ch c    = encode_as_unicode_char c++encode_as_unicode_char :: Char -> EncodedString+encode_as_unicode_char c = 'z' : if isDigit (head hex_str) then hex_str+                                                           else '0':hex_str+  where hex_str = showHex (ord c) "U"+  -- ToDo: we could improve the encoding here in various ways.+  -- eg. strings of unicode characters come out as 'z1234Uz5678U', we+  -- could remove the 'U' in the middle (the 'z' works as a separator).++zDecodeString :: EncodedString -> UserString+zDecodeString [] = []+zDecodeString ('Z' : d : rest)+  | isDigit d = decode_tuple   d rest+  | otherwise = decode_upper   d : zDecodeString rest+zDecodeString ('z' : d : rest)+  | isDigit d = decode_num_esc d rest+  | otherwise = decode_lower   d : zDecodeString rest+zDecodeString (c   : rest) = c : zDecodeString rest++decode_upper, decode_lower :: Char -> Char++decode_upper 'L' = '('+decode_upper 'R' = ')'+decode_upper 'M' = '['+decode_upper 'N' = ']'+decode_upper 'C' = ':'+decode_upper 'Z' = 'Z'+decode_upper ch  = {-pprTrace "decode_upper" (char ch)-} ch++decode_lower 'z' = 'z'+decode_lower 'a' = '&'+decode_lower 'b' = '|'+decode_lower 'c' = '^'+decode_lower 'd' = '$'+decode_lower 'e' = '='+decode_lower 'g' = '>'+decode_lower 'h' = '#'+decode_lower 'i' = '.'+decode_lower 'l' = '<'+decode_lower 'm' = '-'+decode_lower 'n' = '!'+decode_lower 'p' = '+'+decode_lower 'q' = '\''+decode_lower 'r' = '\\'+decode_lower 's' = '/'+decode_lower 't' = '*'+decode_lower 'u' = '_'+decode_lower 'v' = '%'+decode_lower ch  = {-pprTrace "decode_lower" (char ch)-} ch++-- Characters not having a specific code are coded as z224U (in hex)+decode_num_esc :: Char -> EncodedString -> UserString+decode_num_esc d rest+  = go (digitToInt d) rest+  where+    go n (c : rest) | isHexDigit c = go (16*n + digitToInt c) rest+    go n ('U' : rest)           = chr n : zDecodeString rest+    go n other = error ("decode_num_esc: " ++ show n ++  ' ':other)++decode_tuple :: Char -> EncodedString -> UserString+decode_tuple d rest+  = go (digitToInt d) rest+  where+        -- NB. recurse back to zDecodeString after decoding the tuple, because+        -- the tuple might be embedded in a longer name.+    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest+    go 0 ('T':rest)     = "()" ++ zDecodeString rest+    go n ('T':rest)     = '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest+    go 1 ('H':rest)     = "(# #)" ++ 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 1-tuple (not 0-tuple)+  There are no unboxed 0-tuples.++* "()" is the tycon for a boxed 0-tuple.+  There are no boxed 1-tuples.+-}++maybe_tuple :: UserString -> Maybe EncodedString++maybe_tuple "(# #)" = Just("Z1H")+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)+++{-+************************************************************************+*                                                                      *+                        Base 62+*                                                                      *+************************************************************************++Note [Base 62 encoding 128-bit integers]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Instead of base-62 encoding a single 128-bit integer+(ceil(21.49) characters), we'll base-62 a pair of 64-bit integers+(2 * ceil(10.75) characters).  Luckily for us, it's the same number of+characters!+-}++--------------------------------------------------------------------------+-- Base 62++-- The base-62 code is based off of 'locators'+-- ((c) Operational Dynamics Consulting, BSD3 licensed)++-- | Size of a 64-bit word when written as a base-62 string+word64Base62Len :: Int+word64Base62Len = 11++-- | Converts a 64-bit word into a base-62 string+toBase62Padded :: Word64 -> String+toBase62Padded w = pad ++ str+  where+    pad = replicate len '0'+    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)+    str = toBase62 w++toBase62 :: Word64 -> String+toBase62 w = showIntAtBase 62 represent w ""+  where+    represent :: Int -> Char+    represent x+        | x < 10 = Char.chr (48 + x)+        | x < 36 = Char.chr (65 + x - 10)+        | x < 62 = Char.chr (97 + x - 36)+        | otherwise = error "represent (base 62): impossible!"

@@ -3,13 +3,13 @@ import Prelude -- See Note [Why do we import Prelude here?]  cProjectGitCommitId   :: String-cProjectGitCommitId   = "b085d34b3dd036ebcb85e5dc1b07d2b5bdbedbb7"+cProjectGitCommitId   = "82e6bf12786908ccda643dd1dceb42abcc97290c"  cProjectVersion       :: String-cProjectVersion       = "9.0.1"+cProjectVersion       = "9.2.1"  cProjectVersionInt    :: String-cProjectVersionInt    = "900"+cProjectVersionInt    = "902"  cProjectPatchLevel    :: String cProjectPatchLevel    = "1"

@@ -1,10 +1,12 @@+cabal-version:  3.0+ -- WARNING: ghc-boot.cabal is automatically generated from ghc-boot.cabal.in by -- ../../configure.  Make sure you are editing ghc-boot.cabal.in, not -- ghc-boot.cabal.  name:           ghc-boot-version:        9.0.1-license:        BSD3+version:        9.2.1+license:        BSD-3-Clause license-file:   LICENSE category:       GHC maintainer:     ghc-devs@haskell.org@@ -22,7 +24,6 @@                 The package database format and this library are constructed in                 such a way that while ghc-pkg depends on Cabal, the GHC library                 and program do not have to depend on Cabal.-cabal-version:  >=1.22 build-type:     Simple extra-source-files: changelog.md @@ -38,27 +39,38 @@      exposed-modules:             GHC.BaseDir+            GHC.Data.ShortText+            GHC.Data.SizedSeq+            GHC.Utils.Encoding             GHC.LanguageExtensions             GHC.Unit.Database             GHC.Serialized             GHC.ForeignSrcLang             GHC.HandleEncoding-            GHC.Platform+            GHC.Platform.ArchOS             GHC.Platform.Host-            GHC.Settings.Platform             GHC.Settings.Utils             GHC.UniqueSubdir             GHC.Version +    -- reexport modules from ghc-boot-th so that packages don't have to import+    -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to+    -- understand and to refactor.+    reexported-modules:+              GHC.LanguageExtensions.Type+            , GHC.ForeignSrcLang.Type+            , GHC.Lexeme+     -- but done by Hadrian     -- autogen-modules:     --         GHC.Version     --         GHC.Platform.Host -    build-depends: base       >= 4.7 && < 4.16,+    build-depends: base       >= 4.7 && < 4.17,                    binary     == 0.8.*,-                   bytestring == 0.10.*,+                   bytestring >= 0.10 && < 0.12,                    containers >= 0.5 && < 0.7,                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.5,-                   ghc-boot-th == 9.0.1+                   deepseq    >= 1.4 && < 1.5,+                   ghc-boot-th == 9.2.1