[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id-hadrian-hash] IWP

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id-hadrian-hash at Glasgow Haskell Compiler / GHC


Commits:
e38453bb by romes at 2023-03-21T14:37:07+00:00
IWP

- - - - -


6 changed files:

- hadrian/src/Hadrian/BuildPath.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Settings/Builders/Cabal.hs


Changes:

=====================================
hadrian/src/Hadrian/BuildPath.hs
=====================================
@@ -113,7 +113,7 @@ parseWayUnit = Parsec.choice
 -- | Parse a @"pkgname-pkgversion"@ string into the package name and the
 -- integers that make up the package version.
 parsePkgId :: Parsec.Parsec String () (String, [Integer], String)
-parsePkgId = parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>)"
+parsePkgId = parseRTS <|> (parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>-<hash>)")
   where
     parsePkgId' currName = do
         s <- Parsec.many1 Parsec.alphaNum
@@ -122,6 +122,11 @@ parsePkgId = parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>)"
         Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash)
                       , parsePkgId' newName ]
 
+    parseRTS = do
+      _ <- Parsec.string "rts" <* Parsec.char '-'
+      v <- parsePkgVersion
+      pure ("rts", v, "")
+
 parsePkgHash :: Parsec.Parsec String () String
 parsePkgHash = Parsec.many1 Parsec.alphaNum
 


=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -357,12 +357,12 @@ registerPackage rs context = do
 -- This is copied and simplified from Cabal, because we want to install the package
 -- into a different package database to the one it was configured against.
 register :: FilePath
-         -> FilePath
+         -> String -- ^ Package Identifier
          -> FilePath
          -> C.PackageDescription
          -> LocalBuildInfo
          -> IO ()
-register pkg_db conf_file build_dir pd lbi
+register pkg_db pid build_dir pd lbi
   = withLibLBI pd lbi $ \lib clbi -> do
 
     absPackageDBs    <- C.absolutePackageDBPaths packageDbs
@@ -370,16 +370,17 @@ register pkg_db conf_file build_dir pd lbi
                            C.silent pd lib lbi clbi False reloc build_dir
                            (C.registrationPackageDB absPackageDBs)
 
+    liftIO $ putStrLn ("REGFILE: " <> regFile)
     writeRegistrationFile installedPkgInfo
 
   where
-    regFile             = conf_file
+    regFile   = pkg_db </> pid <.> "conf"
     reloc     = relocatable lbi
     -- Using a specific package db here is why we have to copy the function from Cabal.
     packageDbs = [C.SpecificPackageDB pkg_db]
 
     writeRegistrationFile installedPkgInfo = do
-      writeUTF8File (pkg_db </> regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo)
+      writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo)
 
 
 -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at .


=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -40,12 +40,17 @@ pkgUnitId ctx' pkg = do
   let ctx = ctx'{package = pkg}
   pid   <- pkgSimpleIdentifier (package ctx)
   phash <- pkgHash ctx
-  -- Other boot packages still hardcode their unit-id to just <name>, but we
-  -- can have hadrian generate a different unit-id for them just as cabal does
-  -- because the boot packages unit-ids are overriden by setting -this-unit-id
-  -- in the cabal file
-  liftIO $ print $ pid <> "-" <> truncateHash 4 phash
-  pure $ pid <> "-" <> truncateHash 4 phash
+  if pkgName pkg == "rts"
+     -- The Unit-id will change depending on the way... rTS BReaks. At some
+     -- point it's not even clear which way we're building
+     then pure pid
+     else do
+        -- Other boot packages still hardcode their unit-id to just <name>, but we
+        -- can have hadrian generate a different unit-id for them just as cabal does
+        -- because the boot packages unit-ids are overriden by setting -this-unit-id
+        -- in the cabal file
+        liftIO $ print $ pid <> "-" <> truncateHash 4 phash
+        pure $ pid <> "-" <> truncateHash 4 phash
 
   where
     truncateHash :: Int -> String -> String


=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -132,8 +132,8 @@ bindistRules = do
         version        <- setting ProjectVersion
         targetPlatform <- setting TargetPlatformFull
         distDir        <- Context.distDir Stage1
-        -- rtsDir         <- pkgUnitId (vanillaContext Stage1 rts) rts
-        let rtsDir  = "rts"
+        rtsDir         <- pkgUnitId (vanillaContext Stage1 rts) rts
+        -- let rtsDir  = "rts"
 
         let ghcBuildDir      = root -/- stageString Stage1
             bindistFilesDir  = root -/- "bindist" -/- ghcVersionPretty


=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -54,8 +54,8 @@ cabalBuildRules = do
         need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))
 
         distDir        <- Context.distDir Stage1
-        -- rtsDir         <- pkgUnitId (vanillaContext Stage1 rts) rts
-        let rtsDir = "rts"
+        rtsDir         <- pkgUnitId (vanillaContext Stage1 rts) rts
+        -- let rtsDir = "rts"
 
         let ghcBuildDir      = root -/- stageString Stage1
             rtsIncludeDir    = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir


=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -102,7 +102,7 @@ commonCabalArgs stage = do
             , arg "--cabal-file"
             , arg $ pkgCabalFile pkg
             , arg "--ipid"
-            , arg "$pkg-$version"
+            , arg package_id
             , arg "--prefix"
             , arg prefix
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230321/d40285bc/attachment-0001.html>