ghc-boot 9.2.2 → 9.4.1

raw patch · 10 files changed

+170/−90 lines, 10 filesdep ~basedep ~ghc-boot-thbuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, ghc-boot-th

API changes (from Hackage documentation)

Files

• GHC/BaseDir.hs +3/−3
• GHC/Data/ShortText.hs +1/−1
• GHC/HandleEncoding.hs +2/−2
• GHC/Platform/ArchOS.hs +7/−11
• GHC/Platform/Host.hs +0/−12
• GHC/Unit/Database.hs +26/−32
• GHC/Utils/Encoding.hs +1/−1
• GHC/Version.hs +0/−21
• Setup.hs +120/−0
• ghc-boot.cabal +10/−7

@@ -2,7 +2,6 @@  -- | Note [Base Dir] -- ~~~~~~~~~~~~~~~~~--- -- GHC's base directory or top directory containers miscellaneous settings and -- the package database.  The main compiler of course needs this directory to -- read those settings and read and write packages. ghc-pkg uses it to find the@@ -12,6 +11,7 @@ -- will expand `${top_dir}` inside strings so GHC doesn't need to know it's on -- installation location at build time. ghc-pkg also can expand those variables -- and so needs the top dir location to do that too.+ module GHC.BaseDir where  import Prelude -- See Note [Why do we import Prelude here?]@@ -23,7 +23,7 @@ #if defined(mingw32_HOST_OS) import System.Environment (getExecutablePath) -- POSIX-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS) import System.Environment (getExecutablePath) #endif @@ -52,7 +52,7 @@     -- that is running this function.     rootDir :: FilePath -> FilePath     rootDir = takeDirectory . takeDirectory . normalise-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS) -- on unix, this is a bit more confusing. -- The layout right now is something like --

@@ -14,7 +14,7 @@ -- -- 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+#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) {-# OPTIONS_GHC -fignore-interface-pragmas #-} #endif -- |

@@ -10,8 +10,8 @@ -- GHC produces output regardless of OS. configureHandleEncoding :: IO () configureHandleEncoding = do-   env <- getEnvironment-   case lookup "GHC_CHARENC" env of+   mb_val <- lookupEnv "GHC_CHARENC"+   case mb_val of     Just "UTF-8" -> do      hSetEncoding stdout utf8      hSetEncoding stderr utf8

@@ -24,7 +24,7 @@       { archOS_arch :: Arch       , archOS_OS   :: OS       }-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | Architectures --@@ -38,8 +38,6 @@    | ArchPPC    | ArchPPC_64 PPC_64ABI    | ArchS390X-   | ArchSPARC-   | ArchSPARC64    | ArchARM ArmISA [ArmISAExt] ArmABI    | ArchAArch64    | ArchAlpha@@ -47,14 +45,14 @@    | ArchMipsel    | ArchRISCV64    | ArchJavaScript-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | ARM Instruction Set Architecture data ArmISA    = ARMv5    | ARMv6    | ARMv7-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | ARM extensions data ArmISAExt@@ -63,20 +61,20 @@    | VFPv3D16    | NEON    | IWMMX2-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | ARM ABI data ArmABI    = SOFT    | SOFTFP    | HARD-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | PowerPC 64-bit ABI data PPC_64ABI    = ELF_V1 -- ^ PowerPC64    | ELF_V2 -- ^ PowerPC64 LE-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)  -- | Operating systems. --@@ -97,7 +95,7 @@    | OSQNXNTO    | OSAIX    | OSHurd-   deriving (Read, Show, Eq)+   deriving (Read, Show, Eq, Ord)   -- Note [Platform Syntax]@@ -126,8 +124,6 @@   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"

@@ -1,12 +0,0 @@-module GHC.Platform.Host where--import GHC.Platform.ArchOS--hostPlatformArch :: Arch-hostPlatformArch = ArchX86_64--hostPlatformOS   :: OS-hostPlatformOS   = OSLinux--hostPlatformArchOS :: ArchOS-hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS

@@ -88,8 +88,9 @@ import Control.Monad (when) import System.FilePath as FilePath #if !defined(mingw32_HOST_OS)+import Data.Bits ((.|.)) import System.Posix.Files-import GHC.IO.Exception (ioe_type, IOErrorType(NoSuchThing))+import System.Posix.Types (FileMode) #endif import System.IO import System.IO.Error@@ -99,7 +100,7 @@ import System.Directory  -- | @ghc-boot@'s UnitInfo, serialized to the database.-type DbUnitInfo      = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule+type DbUnitInfo      = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule  -- | Information about an unit (a unit is an installed module library). --@@ -109,14 +110,16 @@ -- Some types are left as parameters to be instantiated differently in ghc-pkg -- and in ghc itself. ---data GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo+data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo    { unitId             :: uid       -- ^ Unique unit identifier that is used during compilation (e.g. to       -- generate symbols). -   , unitInstanceOf     :: compid+   , unitInstanceOf     :: uid       -- ^ Identifier of an indefinite unit (i.e. with module holes) that this       -- unit is an instance of.+      --+      -- For non instantiated units, unitInstanceOf=unitId     , unitInstantiations :: [(modulename, mod)]       -- ^ How this unit instantiates some of its module holes. Map hole module@@ -252,16 +255,15 @@ -- | Convert between GenericUnitInfo instances mapGenericUnitInfo    :: (uid1 -> uid2)-   -> (cid1 -> cid2)    -> (srcpkg1 -> srcpkg2)    -> (srcpkgname1 -> srcpkgname2)    -> (modname1 -> modname2)    -> (mod1 -> mod2)-   -> (GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1-       -> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2)-mapGenericUnitInfo fuid fcid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =+   -> (GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1+       -> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2)+mapGenericUnitInfo fuid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =    g { unitId              = fuid unitId-     , unitInstanceOf      = fcid unitInstanceOf+     , unitInstanceOf      = fuid unitInstanceOf      , unitInstantiations  = fmap (bimap fmodname fmod) unitInstantiations      , unitPackageId       = fsrcpkg unitPackageId      , unitPackageName     = fsrcpkgname unitPackageName@@ -412,8 +414,14 @@ -- | Write the whole of the package DB, both parts. -- writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()-writePackageDb file ghcPkgs ghcPkgPart =+writePackageDb file ghcPkgs ghcPkgPart = do   writeFileAtomic file (runPut putDbForGhcPkg)+#if !defined(mingw32_HOST_OS)+  addFileMode file 0o444+  --  ^ In case the current umask is too restrictive force all read bits to+  --  allow access.+#endif+  return ()   where     putDbForGhcPkg = do         putHeader@@ -425,6 +433,13 @@         ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)         ghcPart    = encode ghcPkgs +#if !defined(mingw32_HOST_OS)+addFileMode :: FilePath -> FileMode -> IO ()+addFileMode file m = do+  o <- fileMode <$> getFileStatus file+  setFileMode file (m .|. o)+#endif+ getHeader :: Get (Word32, Word32) getHeader = do     magic <- getByteString (BS.length headerMagic)@@ -507,26 +522,6 @@ -- Copied from Cabal's Distribution.Simple.Utils. writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO () writeFileAtomic targetPath content = do-  -- Figure out how to update the file mode after we create the temporary file-  let no_update _path = return ()-#if !defined(mingw32_HOST_OS)-  let on_error ioe =-          -- If the file doesn't yet exist then just use the default owner and-          -- mode.-          case ioe_type ioe of-            NoSuchThing -> return no_update-            _ -> ioError ioe-  let handleIO :: (IOException -> IO a) -> IO a -> IO a-      handleIO = flip catch-  set_metadata <- handleIO on_error $ do-      status <- getFileStatus targetPath-      return $ \path -> do-        setFileMode path (fileMode status)-        setOwnerAndGroup path (fileOwner status) (fileGroup status)-#else-  let set_metadata = no_update-#endif-   let (targetDir, targetFile) = splitFileName targetPath   Exception.bracketOnError     (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")@@ -534,7 +529,6 @@     (\(tmpPath, handle) -> do         BS.Lazy.hPut handle content         hClose handle-        set_metadata tmpPath         renameFile tmpPath targetPath)  instance Binary DbUnitInfo where@@ -711,7 +705,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 :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f+mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e -> GenericUnitInfo a b c d e mungeUnitInfoPaths top_dir pkgroot pkg =    -- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs     pkg

@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, MultiWayIf #-} {-# 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`

@@ -1,21 +0,0 @@-module GHC.Version where--import Prelude -- See Note [Why do we import Prelude here?]--cProjectGitCommitId   :: String-cProjectGitCommitId   = "fbaee70d380973f71fa6e9e15be746532e5a4fc5"--cProjectVersion       :: String-cProjectVersion       = "9.2.2"--cProjectVersionInt    :: String-cProjectVersionInt    = "902"--cProjectPatchLevel    :: String-cProjectPatchLevel    = "2"--cProjectPatchLevel1   :: String-cProjectPatchLevel1   = "2"--cProjectPatchLevel2   :: String-cProjectPatchLevel2   = ""

@@ -0,0 +1,120 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-}+module Main where++import Distribution.Simple+import Distribution.Simple.BuildPaths+import Distribution.Types.LocalBuildInfo+import Distribution.Verbosity+import Distribution.Simple.Program+import Distribution.Simple.Utils+import Distribution.Simple.Setup++import System.IO+import System.Directory+import System.FilePath+import System.Environment+import Control.Monad+import Data.Char+import GHC.ResponseFile++main :: IO ()+main = defaultMainWithHooks ghcHooks+  where+    ghcHooks = simpleUserHooks+      { postConf = \args cfg pd lbi -> do+          let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)+          ghcAutogen verbosity lbi+          postConf simpleUserHooks args cfg pd lbi+      }++ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()+ghcAutogen verbosity lbi@LocalBuildInfo{..} = do+  -- Get compiler/ root directory from the cabal file+  let Just compilerRoot = takeDirectory <$> pkgDescrFile++  let platformHostFile = "GHC/Platform/Host.hs"+      platformHostPath = autogenPackageModulesDir lbi </> platformHostFile+      ghcVersionFile = "GHC/Version.hs"+      ghcVersionPath = autogenPackageModulesDir lbi </> ghcVersionFile++  -- Get compiler settings+  settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case+    Just settings -> pure $ Left $ read settings+    Nothing -> do+      (ghc,withPrograms) <- requireProgram normal ghcProgram withPrograms+      Right . read <$> getProgramOutput normal ghc ["--info"]++  -- Write GHC.Platform.Host+  createDirectoryIfMissingVerbose verbosity True (takeDirectory platformHostPath)+  rewriteFileEx verbosity platformHostPath (generatePlatformHostHs settings)++  -- Write GHC.Version+  createDirectoryIfMissingVerbose verbosity True (takeDirectory ghcVersionPath)+  rewriteFileEx verbosity ghcVersionPath (generateVersionHs settings)++-- | Takes either a list of hadrian generated settings, or a list of settings from ghc --info,+-- and keys in both lists, and looks up the value in the appropriate list+getSetting :: Either [(String,String)] [(String,String)] -> String -> String -> Either String String+getSetting settings kh kr = case settings of+  Left settings -> go settings kh+  Right settings -> go settings kr+  where+    go settings k =  case lookup k settings of+      Nothing -> Left (show k ++ " not found in settings: " ++ show settings)+      Just v -> Right v++generatePlatformHostHs :: Either [(String,String)] [(String,String)] -> String+generatePlatformHostHs settings = either error id $ do+    let getSetting' = getSetting settings+    cHostPlatformArch <- getSetting' "hostPlatformArch" "target arch"+    cHostPlatformOS   <- getSetting' "hostPlatformOS"   "target os"+    return $ unlines+        [ "module GHC.Platform.Host where"+        , ""+        , "import GHC.Platform.ArchOS"+        , ""+        , "hostPlatformArch :: Arch"+        , "hostPlatformArch = " ++ cHostPlatformArch+        , ""+        , "hostPlatformOS   :: OS"+        , "hostPlatformOS   = " ++ cHostPlatformOS+        , ""+        , "hostPlatformArchOS :: ArchOS"+        , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS"+        ]++generateVersionHs :: Either [(String,String)] [(String,String)] -> String+generateVersionHs settings = either error id $ do+    let getSetting' = getSetting settings+    cProjectGitCommitId <- getSetting' "cProjectGitCommitId" "Project Git commit id"+    cProjectVersion     <- getSetting' "cProjectVersion"     "Project version"+    cProjectVersionInt  <- getSetting' "cProjectVersionInt"  "Project Version Int"++    cProjectPatchLevel  <- getSetting' "cProjectPatchLevel"  "Project Patch Level"+    cProjectPatchLevel1 <- getSetting' "cProjectPatchLevel1" "Project Patch Level1"+    cProjectPatchLevel2 <- getSetting' "cProjectPatchLevel2" "Project Patch Level2"+    return $ unlines+        [ "module GHC.Version where"+        , ""+        , "import Prelude -- See Note [Why do we import Prelude here?]"+        , ""+        , "cProjectGitCommitId   :: String"+        , "cProjectGitCommitId   = " ++ show cProjectGitCommitId+        , ""+        , "cProjectVersion       :: String"+        , "cProjectVersion       = " ++ show cProjectVersion+        , ""+        , "cProjectVersionInt    :: String"+        , "cProjectVersionInt    = " ++ show cProjectVersionInt+        , ""+        , "cProjectPatchLevel    :: String"+        , "cProjectPatchLevel    = " ++ show cProjectPatchLevel+        , ""+        , "cProjectPatchLevel1   :: String"+        , "cProjectPatchLevel1   = " ++ show cProjectPatchLevel1+        , ""+        , "cProjectPatchLevel2   :: String"+        , "cProjectPatchLevel2   = " ++ show cProjectPatchLevel2+        ]

@@ -5,7 +5,7 @@ -- ghc-boot.cabal.  name:           ghc-boot-version:        9.2.2+version:        9.4.1 license:        BSD-3-Clause license-file:   LICENSE category:       GHC@@ -24,9 +24,12 @@                 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.-build-type:     Simple+build-type:     Custom extra-source-files: changelog.md +custom-setup+    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.9, directory, filepath+ source-repository head     type:     git     location: https://gitlab.haskell.org/ghc/ghc.git@@ -62,18 +65,18 @@             , GHC.Lexeme      -- but done by Hadrian-    -- autogen-modules:-    --         GHC.Version-    --         GHC.Platform.Host+    autogen-modules:+            GHC.Version+            GHC.Platform.Host -    build-depends: base       >= 4.7 && < 4.17,+    build-depends: base       >= 4.7 && < 4.18,                    binary     == 0.8.*,                    bytestring >= 0.10 && < 0.12,                    containers >= 0.5 && < 0.7,                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.5,                    deepseq    >= 1.4 && < 1.5,-                   ghc-boot-th == 9.2.2+                   ghc-boot-th == 9.4.1     if !os(windows)         build-depends:                    unix       >= 2.7 && < 2.8