[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] wip finalize

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Mon Mar 27 09:30:50 UTC 2023



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


Commits:
b68118ae by romes at 2023-03-27T10:30:42+01:00
wip finalize

- - - - -


3 changed files:

- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Cabal.hs
- hadrian/src/Hadrian/Haskell/Hash.hs


Changes:

=====================================
hadrian/src/Context.hs
=====================================
@@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
 pkgHaddockFile :: Context -> Action FilePath
 pkgHaddockFile context at Context {..} = do
     root <- buildRoot
-    version <- pkgUnitId context package
+    version <- pkgSimpleIdentifier package
     return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
 
 -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:


=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -10,7 +10,7 @@
 -- Cabal files.
 -----------------------------------------------------------------------------
 module Hadrian.Haskell.Cabal (
-    pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription,
+    pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier,
     pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString
     ) where
 
@@ -27,6 +27,17 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId)
 pkgVersion :: Package -> Action String
 pkgVersion = fmap version . readPackageData
 
+-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
+-- The Cabal file is tracked.
+--
+-- For an identifier complete with the hash use 'pkgUnitId'
+pkgSimpleIdentifier :: Package -> Action String
+pkgSimpleIdentifier package = do
+    cabal <- readPackageData package
+    return $ if null (version cabal)
+        then name cabal
+        else name cabal ++ "-" ++ version cabal
+
 -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
 pkgSynopsis :: Package -> Action String
 pkgSynopsis = fmap synopsis . readPackageData


=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where
 
 import Development.Shake
 
-import Hadrian.Haskell.Cabal.Type as C
+import Hadrian.Haskell.Cabal.Type
 import Hadrian.Haskell.Cabal
 import Hadrian.Oracles.Cabal
 import Hadrian.Package
@@ -41,32 +41,19 @@ pkgUnitId ctx' pkg = do
   pid   <- pkgSimpleIdentifier (package ctx)
   phash <- pkgHash ctx
   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
+     -- The unit-id will change depending on the way, we need to treat the rts separately
      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
     truncateHash = take
 
--- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
--- The Cabal file is tracked.
---
--- For an identifier complete with the hash use 'pkgUnitId'
-pkgSimpleIdentifier :: Package -> Action String
-pkgSimpleIdentifier package = do
-    cabal <- readPackageData package
-    return $ if null (version cabal)
-        then C.name cabal
-        else C.name cabal ++ "-" ++ version cabal
-
 data PackageHashInputs = PackageHashInputs {
        pkgHashPkgId         :: String, -- ^ name-version
        pkgHashComponent     :: PackageType,
@@ -119,17 +106,14 @@ type instance RuleResult PkgHashKey = String
 pkgHash :: Context -> Action String
 pkgHash = askOracle . PkgHashKey
 
--- TODO: Needs to be oracle to be cached? Called lots of times
+-- Needs to be an oracle to be cached. Called lots of times.
 pkgHashOracle :: Rules ()
 pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
-  -- RECURSIVE ORACLE: ctx_data <- readContextData ctx
   pkg_data <- readPackageData (package ctx)
   name <- pkgSimpleIdentifier (package ctx)
   let stag = stage ctx
-  liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data)
   stagePkgs <- stagePackages stag
   depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs]
-  liftIO $ print ("Pkg Deps Hashes", depsHashes)
   flav <- flavour
   let flavourArgs = args flav
 
@@ -139,13 +123,13 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
   libWays <- interpretInContext ctx (libraryWays flav)
   dyn_ghc <- dynamicGhcPrograms flav
   flags <-  interpret (target ctx (Cabal Flags stag) [] []) flavourArgs
+  liftIO$ print ("flav", flav)
   let pkgHashFlagAssignment = flags
       pkgHashConfigureScriptArgs = ""
       pkgHashVanillaLib = vanilla `Set.member` libWays
       pkgHashSharedLib = dynamic `Set.member` libWays
       pkgHashDynExe = dyn_ghc
-      -- TODO: fullyStatic flavour transformer
-      pkgHashFullyStaticExe = False
+      pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer
       pkgHashGHCiLib = False
       pkgHashProfLib = profiling `Set.member` libWays
       pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag
@@ -158,7 +142,9 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
       pkgHashDebugInfo = undefined
 
   -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs
-  let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs
+  let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs,
+                                  -- but the above call to 'interpret' causes a
+                                  -- build-time loop
       pkgHashExtraLibDirs = []
       pkgHashExtraLibDirsStatic = []
       pkgHashExtraFrameworkDirs = []
@@ -172,7 +158,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
        pkgHashPkgId       = name
     ,  pkgHashComponent   = pkgType (package ctx)
     ,  pkgHashSourceHash  = ""
-    ,  pkgHashDirectDeps  = Set.empty
+    ,  pkgHashDirectDeps  = Set.fromList depsHashes
     ,  pkgHashOtherConfig = other_config
     }
 



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68118ae8d861e4d98e637dc251636efcb3751f0
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/20230327/342c2495/attachment-0001.html>


More information about the ghc-commits mailing list