Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • changelog.d/libdir-setting
    1 
    +section: packaging
    2 
    +synopsis: Added a new optional configuration setting for `LibDir` to support inplace
    3 
    +  stage2 cross-compilers where binaries and libraries are in different stage
    4 
    +  directories.
    5 
    +issues: #19174
    6 
    +mrs: !15716
    7 
    +
    8 
    +description: {
    9 
    +  Previously, the `libDir` was always derived from `topDir`, which won't work
    10 
    +  for inplace stage2 cross-compilers where executables are in `_build/stage1/`
    11 
    +  and libraries are in `_build/stage2/`. Now, `LibDir` can be set, but is by
    12 
    +  default derived from `topDir`. This facilitates the mentioned behaviour
    13 
    +  while keeping the binary distribution code relocatable. This is a refactoring
    14 
    +  step that does not change actual behaviour.
    15 
    +}

  • compiler/GHC/Driver/Config/Interpreter.hs
    ... ... @@ -17,8 +17,8 @@ import System.Directory
    17 17
    18 18 
     initInterpOpts :: DynFlags -> IO InterpOpts
    19 19 
     initInterpOpts dflags = do
    20 
    -  wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs"
    21 
    -  js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js"
    20 
    +  wasm_dyld <- makeAbsolute $ libDir dflags </> "dyld.mjs"
    21 
    +  js_interp <- makeAbsolute $ libDir dflags </> "ghc-interp.js"
    22 22 
       pure $ InterpOpts
    23 23 
         { interpExternal = gopt Opt_ExternalInterpreter dflags
    24 24 
         , interpProg = pgm_i dflags

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -60,7 +60,7 @@ module GHC.Driver.DynFlags (
    60 60
    61 61 
             -- ** System tool settings and locations
    62 62 
             programName, projectVersion,
    63 
    -        ghcUsagePath, ghciUsagePath, topDir, toolDir,
    63 
    +        ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir,
    64 64 
             versionedAppDir, versionedFilePath,
    65 65 
             extraGccViaCFlags, globalPackageDatabasePath,
    66 66
    ... ... @@ -1508,6 +1508,8 @@ ghciUsagePath :: DynFlags -> FilePath
    1508 1508 
     ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
    1509 1509 
     topDir                :: DynFlags -> FilePath
    1510 1510 
     topDir dflags = fileSettings_topDir $ fileSettings dflags
    1511 
    +libDir                :: DynFlags -> FilePath
    1512 
    +libDir dflags = fileSettings_libDir $ fileSettings dflags
    1511 1513 
     toolDir               :: DynFlags -> Maybe FilePath
    1512 1514 
     toolDir dflags = fileSettings_toolDir $ fileSettings dflags
    1513 1515 
     extraGccViaCFlags     :: DynFlags -> [String]

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -3548,9 +3548,9 @@ compilerInfo dflags
    3548 3548 
           ("Project name",                 cProjectName)
    3549 3549 
           -- Next come the settings, so anything else can be overridden
    3550 3550 
           -- in the settings file (as "lookup" uses the first match for the
    3551 
    -      -- key)
    3551 
    +      -- key). We filter out LibDir from rawSettings to avoid duplication.
    3552 3552 
          : map (fmap expandDirectories)
    3553 
    -           (rawSettings dflags)
    3553 
    +           (filter ((/= "LibDir") . fst) (rawSettings dflags))
    3554 3554 
          ++
    3555 3555 
           [("C compiler command", queryCmd $ ccProgram . tgtCCompiler),
    3556 3556 
            ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler),
    ... ... @@ -3651,7 +3651,7 @@ compilerInfo dflags
    3651 3651 
            -- Whether or not GHC was compiled using -prof
    3652 3652 
            ("GHC Profiled",                showBool hostIsProfiled),
    3653 3653 
            ("Debug on",                    showBool debugIsOn),
    3654 
    -       ("LibDir",                      topDir dflags),
    3654 
    +       ("LibDir",                      libDir dflags),
    3655 3655 
            -- This is always an absolute path, unlike "Relative Global Package DB" which is
    3656 3656 
            -- in the settings file.
    3657 3657 
            ("Global Package DB",           globalPackageDatabasePath dflags)

  • compiler/GHC/Settings.hs
    ... ... @@ -184,6 +184,7 @@ data FileSettings = FileSettings
    184 184 
       , fileSettings_toolDir               :: Maybe FilePath -- ditto
    185 185 
       , fileSettings_topDir                :: FilePath       -- ditto
    186 186 
       , fileSettings_globalPackageDatabase :: FilePath
    187 
    +  , fileSettings_libDir                :: FilePath
    187 188 
       }
    188 189
    189 190

  • compiler/GHC/Settings/IO.hs
    ... ... @@ -28,6 +28,7 @@ import GHC.Toolchain.Program
    28 28 
     import GHC.Toolchain
    29 29 
     import GHC.Data.Maybe
    30 30 
     import Data.Bifunctor (Bifunctor(second))
    31 
    +import Data.Either (fromRight)
    31 32
    32 33 
     data SettingsError
    33 34 
       = SettingsError_MissingData String
    ... ... @@ -148,6 +149,13 @@ initSettings top_dir = do
    148 149
    149 150 
       baseUnitId <- getSetting_raw "base unit-id"
    150 151
    152 
    +  -- LibDir is optional. If not set, derive it from topDir. This allows
    153 
    +  -- bindists to work without explicitly setting LibDir, but gives us the
    154 
    +  -- option to override it for inplace test compilers (the "stage2
    155 
    +  -- cross-compiler" scenario).
    156 
    +  let lib_dir = fromRight top_dir $
    157 
    +                  getRawFilePathSetting top_dir settingsFile mySettings "LibDir"
    158 
    +
    151 159 
       return $ Settings
    152 160 
         { sGhcNameVersion = GhcNameVersion
    153 161 
           { ghcNameVersion_programName = "ghc"
    ... ... @@ -159,6 +167,7 @@ initSettings top_dir = do
    159 167 
           , fileSettings_ghciUsagePath  = ghci_usage_msg_path
    160 168 
           , fileSettings_toolDir        = mtool_dir
    161 169 
           , fileSettings_topDir         = top_dir
    170 
    +      , fileSettings_libDir         = lib_dir
    162 171 
           , fileSettings_globalPackageDatabase = globalpkgdb_path
    163 172 
           }
    164 173

  • hadrian/src/Rules/BinaryDist.hs
    ... ... @@ -14,6 +14,7 @@ import qualified System.Directory.Extra as IO
    14 14 
     import Data.Either
    15 15 
     import qualified Data.Set as Set
    16 16 
     import Oracles.Flavour
    17 
    +import Rules.Generate (generateSettings)
    17 18
    18 19 
     {-
    19 20 
     Note [Binary distributions]
    ... ... @@ -218,6 +219,16 @@ bindistRules = do
    218 219 
                       IO.createFileLink version_prog versioned_runhaskell_path
    219 220
    220 221 
             copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir
    222 
    +
    223 
    +      -- Regenerate settings file without LibDir. For bindists, LibDir should
    224 
    +      -- be derived from topdir at runtime such that the GHC binary is
    225 
    +      -- relocatable.
    226 
    +        let bindistSettings = bindistFilesDir -/- "lib" -/- "settings"
    227 
    +            bindistContext = vanillaContext Stage1 compiler
    228 
    +        bindistSettingsContent <- interpretInContext bindistContext $
    229 
    +            generateSettings bindistSettings False (bindistFilesDir -/- "lib" -/- "package.conf.d")
    230 
    +        writeFile' bindistSettings bindistSettingsContent
    231 
    +
    221 232 
             copyDirectory (rtsIncludeDir)         bindistFilesDir
    222 233 
             when windowsHost $ createGhcii (bindistFilesDir -/- "bin")
    223 234

  • hadrian/src/Rules/Generate.hs
    1 1 
     module Rules.Generate (
    2 2 
         isGeneratedCmmFile, compilerDependencies, generatePackageCode,
    3 3 
         generateRules, copyRules, generatedDependencies,
    4 
    -    templateRules
    4 
    +    templateRules, generateSettings
    5 5 
         ) where
    6 6
    7 7 
     import Development.Shake.FilePath
    ... ... @@ -25,6 +25,7 @@ import Utilities
    25 25 
     import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
    26 26 
     import GHC.Platform.ArchOS
    27 27 
     import Settings.Program (ghcWithInterpreter)
    28 
    +import Hadrian.Oracles.Path
    28 29
    29 30 
     -- | Track this file to rebuild generated files whenever it changes.
    30 31 
     trackGenerateHs :: Expr ()
    ... ... @@ -256,8 +257,17 @@ generateRules = do
    256 257
    257 258 
         forM_ allStages $ \stage -> do
    258 259 
             let prefix = root -/- stageString stage -/- "lib"
    259 
    -            go gen file = generate file (semiEmptyTarget (succStage stage)) gen
    260 
    -        (prefix -/- "settings") %> \out -> go (generateSettings out) out
    260 
    +            -- Stage0 compiler builds Stage1, Stage1 -> Stage2, etc.
    261 
    +            buildStage = succStage stage
    262 
    +            go gen file = generate file (semiEmptyTarget buildStage) gen
    263 
    +        (prefix -/- "settings") %> \out -> do
    264 
    +            let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final)
    265 
    +            pkgDb <- case buildStage of
    266 
    +                Stage0 {} -> error "Unable to generate settings for stage0. This should never be reached."
    267 
    +                Stage1 -> get_pkg_db Stage1
    268 
    +                Stage2 -> get_pkg_db Stage1
    269 
    +                Stage3 -> get_pkg_db Stage2
    270 
    +            go (generateSettings out True pkgDb) out
    261 271 
             (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr getTargetTarget) out
    262 272
    263 273 
       where
    ... ... @@ -459,19 +469,16 @@ ghcWrapper stage = do
    459 469 
         return $ unwords $ map show $ [ ghcPath ]
    460 470 
                                    ++ [ "$@" ]
    461 471
    462 
    -generateSettings :: FilePath -> Expr String
    463 
    -generateSettings settingsFile = do
    472 
    +-- | Generate settings file, optionally including @LibDir@.
    473 
    +--
    474 
    +-- @pkgDb@: absolute path to the package DB for the @"Relative Global Package
    475 
    +-- DB"@ setting. Callers determine the correct path (in-tree or bindist). For
    476 
    +-- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime.
    477 
    +generateSettings :: FilePath -> Bool -> FilePath -> Expr String
    478 
    +generateSettings settingsFile includeLibDir package_db_path = do
    464 479 
         ctx <- getContext
    465 480 
         stage <- getStage
    466 481
    467 
    -    package_db_path <- expr $ do
    468 
    -      let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final)
    469 
    -      case stage of
    470 
    -        Stage0 {} -> error "Unable to generate settings for stage0"
    471 
    -        Stage1 -> get_pkg_db Stage1
    472 
    -        Stage2 -> get_pkg_db Stage1
    473 
    -        Stage3 -> get_pkg_db Stage2
    474 
    -
    475 482 
         -- The unit-id of the base package which is always linked against (#25382)
    476 483 
         base_unit_id <- expr $ do
    477 484 
           case stage of
    ... ... @@ -481,14 +488,26 @@ generateSettings settingsFile = do
    481 488 
             Stage3 -> pkgUnitId Stage2 base
    482 489
    483 490 
         let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path
    491 
    +        make_absolute rel_path = do
    492 
    +          abs_path <- liftIO (makeAbsolute rel_path)
    493 
    +          fixAbsolutePathOnWindows abs_path
    494 
    +
    495 
    +        -- E.g. the Stage2 compiler lives in _build/stage1
    496 
    +        -- So, we need to decrement the stage to get the correct directory
    497 
    +        stage_dir_stage = predStage stage
    498 
    +
    499 
    +    rel_lib_topDir :: FilePath <- expr $ stageLibPath stage_dir_stage
    500 
    +    lib_topDir :: FilePath <- expr $ make_absolute rel_lib_topDir
    484 501
    485 502 
         settings <- traverse sequence $
    486 
    -        [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
    487 
    -        , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage))
    488 
    -        , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
    489 
    -        , ("Relative Global Package DB", pure rel_pkg_db)
    490 
    -        , ("base unit-id", pure base_unit_id)
    491 
    -        ]
    503 
    +          [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
    504 
    +          , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage))
    505 
    +          , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
    506 
    +          , ("Relative Global Package DB", pure rel_pkg_db)
    507 
    +          , ("base unit-id", pure base_unit_id)
    508 
    +          ]
    509 
    +          ++ ([("LibDir", pure lib_topDir) | includeLibDir])
    510 
    +
    492 511 
         let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
    493 512 
         pure $ case settings of
    494 513 
             [] -> "[]"

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help