Add additional stage1 module exclusion flags

Add new flags to further reduce stage1 compilation:

- -llvm-backend: Exclude LLVM codegen (~17 modules, ~4200 lines).
  Guard LlvmConfigCache, CodeOutput, Pipeline/Execute LLVM phases.
  Move CmmToLlvm.Version modules to unconditional section (needed by
  GHC.Driver.Errors.Ppr and GHC.SysTools).

- +host-ncg-only: Restrict NCG to host architecture using Cabal's
  arch() condition. Saves 8-10 modules per platform.

- -hpc: Gate GHC.HsToCore.Coverage behind conditional. Stub out
  writeMixEntries and hpcInitCode when disabled (~540 lines).

- Move GHC.Stg.BcPrep behind interpreter flag (~200 lines).

Restore debug RTS default for ghc-bin (accidentally changed when
adding -frontend-plugins flag).

Author: angerman

cabal.project.stage1

@@ -75,9 +75,11 @@ package ghc
   flags: +bootstrap
          +x86-ncg +aarch64-ncg
          -ppc-ncg -riscv64-ncg -loongarch64-ncg
+         +host-ncg-only
          -js-backend -wasm-backend
-         +llvm-backend
+         -llvm-backend
          -interpreter -dynamic-linker
+         -hpc
 
 package ghc-bin
   flags: -frontend-plugins

compiler/GHC/Driver/CodeOutput.hs

@@ -4,6 +4,7 @@
 \section{Code output phase}
 -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module GHC.Driver.CodeOutput
@@ -20,7 +21,9 @@ import GHC.ForeignSrcLang
 import GHC.Data.FastString
 
 import GHC.CmmToAsm     ( nativeCodeGen )
+#if defined(HAVE_LLVM_BACKEND)
 import GHC.CmmToLlvm    ( llvmCodeGen )
+#endif
 
 import GHC.CmmToC           ( cmmToC )
 import GHC.Cmm.Lint         ( cmmLint )
@@ -32,7 +35,9 @@ import GHC.StgToCmm.CgUtils (CgStream)
 import GHC.Driver.DynFlags
 import GHC.Driver.Config.Finder    ( initFinderOpts   )
 import GHC.Driver.Config.CmmToAsm  ( initNCGConfig    )
+#if defined(HAVE_LLVM_BACKEND)
 import GHC.Driver.Config.CmmToLlvm ( initLlvmCgConfig )
+#endif
 import GHC.Driver.LlvmConfigCache  (LlvmConfigCache)
 import GHC.Driver.Ppr
 import GHC.Driver.Backend
@@ -50,7 +55,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Logger
 import GHC.Utils.Exception ( bracket )
 import GHC.Utils.Ppr (Mode(..))
-import GHC.Utils.Panic.Plain ( pgmError )
+import GHC.Utils.Panic.Plain ( pgmError, panic )
 
 import GHC.Unit
 import GHC.Unit.Finder      ( mkStubPaths )
@@ -131,8 +136,16 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g
                  NcgCodeOutput  -> outputAsm logger dflags this_mod location filenm dus1
                                              final_stream
                  ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps
+#if defined(HAVE_LLVM_BACKEND)
                  LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream
+#else
+                 LlvmCodeOutput -> panic "codeOutput: LLVM backend not available (HAVE_LLVM_BACKEND not defined)"
+#endif
+#if defined(HAVE_JS_BACKEND)
                  JSCodeOutput   -> outputJS logger llvm_config dflags filenm final_stream
+#else
+                 JSCodeOutput   -> panic "codeOutput: JS backend not available (HAVE_JS_BACKEND not defined)"
+#endif
         ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs
         ; return (filenm, stubs_exist, foreign_fps, a)
         }
@@ -216,6 +229,7 @@ outputAsm logger dflags this_mod location filenm dus cmm_stream = do
       runUDSMT dus $ setTagUDSMT 'n' $
       nativeCodeGen logger (toolSettings dflags) ncg_config location h cmm_stream
 
+#if defined(HAVE_LLVM_BACKEND)
 {-
 ************************************************************************
 *                                                                      *
@@ -233,7 +247,9 @@ outputLlvm logger llvm_config dflags filenm dus cmm_stream = do
   {-# SCC "llvm_output" #-} doOutput filenm $
     \f -> {-# SCC "llvm_CodeGen" #-}
       llvmCodeGen logger lcg_config f dus cmm_stream
+#endif
 
+#if defined(HAVE_JS_BACKEND)
 {-
 ************************************************************************
 *                                                                      *
@@ -245,6 +261,7 @@ outputJS :: Logger -> LlvmConfigCache -> DynFlags -> FilePath -> CgStream RawCmm
 outputJS _ _ _ _ _ = pgmError $ "codeOutput: Hit JavaScript case. We should never reach here!"
                               ++ "\nThe JS backend should shortcircuit to StgToJS after Stg."
                               ++ "\nIf you reached this point then you've somehow made it to Cmm!"
+#endif
 
 {-
 ************************************************************************

compiler/GHC/Driver/Config/Stg/Pipeline.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module GHC.Driver.Config.Stg.Pipeline
   ( initStgPipelineOpts
   ) where
@@ -42,7 +43,9 @@ getStgToDo for_bytecode dflags =
     -- See Note [StgCse after unarisation] in GHC.Stg.CSE
     , optional Opt_StgCSE StgCSE
     , optional Opt_StgLiftLams $ StgLiftLams $ initStgLiftConfig dflags
+#if defined(HAVE_INTERPRETER)
     , runWhen for_bytecode StgBcPrep
+#endif
     , optional Opt_StgStats StgStats
     ] where
       optional opt = runWhen (gopt opt dflags)

compiler/GHC/Driver/LlvmConfigCache.hs

@@ -1,14 +1,19 @@
+{-# LANGUAGE CPP #-}
+
 -- | LLVM config cache
 module GHC.Driver.LlvmConfigCache
   ( LlvmConfigCache
   , initLlvmConfigCache
+#if defined(HAVE_LLVM_BACKEND)
   , readLlvmConfigCache
+#endif
   )
 where
 
 import GHC.Prelude
-import GHC.CmmToLlvm.Config
 
+#if defined(HAVE_LLVM_BACKEND)
+import GHC.CmmToLlvm.Config
 import System.IO.Unsafe
 
 -- | Cache LLVM configuration read from files in top_dir
@@ -24,3 +29,14 @@ initLlvmConfigCache top_dir = pure $ LlvmConfigCache (unsafePerformIO $ initLlvm
 
 readLlvmConfigCache :: LlvmConfigCache -> IO LlvmConfig
 readLlvmConfigCache (LlvmConfigCache !config) = pure config
+
+#else
+
+-- | Stub when LLVM backend is not available. The type must exist because
+-- it is a field in HscEnv (GHC.Driver.Env.Types).
+data LlvmConfigCache = LlvmConfigCache
+
+initLlvmConfigCache :: FilePath -> IO LlvmConfigCache
+initLlvmConfigCache _ = pure LlvmConfigCache
+
+#endif

compiler/GHC/Driver/Pipeline/Execute.hs

@@ -42,11 +42,15 @@ import GHC.Fingerprint
 import GHC.Utils.Logger
 import GHC.Utils.TmpFs
 import GHC.Platform
+#if defined(HAVE_LLVM_BACKEND)
 import Data.List (intercalate, isInfixOf)
+#endif
 import GHC.Unit.Env
 import GHC.Utils.Error
 import Data.Maybe
+#if defined(HAVE_LLVM_BACKEND)
 import GHC.CmmToLlvm.Mangler
+#endif
 import GHC.SysTools
 import GHC.SysTools.Cpp
 import System.Directory
@@ -67,8 +71,10 @@ import GHC.Unit.Finder
 import Data.IORef
 import GHC.Types.Name.Env
 import GHC.Platform.Ways
+#if defined(HAVE_LLVM_BACKEND)
 import GHC.Driver.LlvmConfigCache (readLlvmConfigCache)
 import GHC.CmmToLlvm.Config (LlvmTarget (..), LlvmConfig (..))
+#endif
 import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub)
 import GHC.Settings
 import System.IO
@@ -151,6 +157,7 @@ runPhase (T_Cmm pipe_env hsc_env input_fn) = do
 runPhase (T_Cc phase pipe_env hsc_env location input_fn) = runCcPhase phase pipe_env hsc_env location input_fn
 runPhase (T_As cpp pipe_env hsc_env location input_fn) = do
   runAsPhase cpp pipe_env hsc_env location input_fn
+#if defined(HAVE_LLVM_BACKEND)
 runPhase (T_LlvmOpt pipe_env hsc_env input_fn) =
   runLlvmOptPhase pipe_env hsc_env input_fn
 runPhase (T_LlvmLlc pipe_env hsc_env input_fn) =
@@ -159,16 +166,24 @@ runPhase (T_LlvmAs cpp pipe_env hsc_env location input_fn) = do
   runLlvmAsPhase cpp pipe_env hsc_env location input_fn
 runPhase (T_LlvmMangle pipe_env hsc_env input_fn) =
   runLlvmManglePhase pipe_env hsc_env input_fn
+#else
+runPhase T_LlvmOpt{} = panic "runPhase: LLVM backend not available (HAVE_LLVM_BACKEND not defined)"
+runPhase T_LlvmLlc{} = panic "runPhase: LLVM backend not available (HAVE_LLVM_BACKEND not defined)"
+runPhase T_LlvmAs{}  = panic "runPhase: LLVM backend not available (HAVE_LLVM_BACKEND not defined)"
+runPhase T_LlvmMangle{} = panic "runPhase: LLVM backend not available (HAVE_LLVM_BACKEND not defined)"
+#endif
 runPhase (T_MergeForeign pipe_env hsc_env input_fn fos) =
   runMergeForeign pipe_env hsc_env input_fn fos
 
+#if defined(HAVE_LLVM_BACKEND)
 runLlvmManglePhase :: PipeEnv -> HscEnv -> FilePath -> IO [Char]
 runLlvmManglePhase pipe_env hsc_env input_fn = do
       let next_phase = As False
       output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing
       let dflags = hsc_dflags hsc_env
       llvmFixupAsm (targetPlatform dflags) input_fn output_fn
       return output_fn
+#endif
 
 runMergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> IO FilePath
 runMergeForeign _pipe_env hsc_env input_fn foreign_os = do
@@ -185,6 +200,7 @@ runMergeForeign _pipe_env hsc_env input_fn foreign_os = do
          joinObjectFiles hsc_env (new_o : foreign_os) input_fn
          return input_fn
 
+#if defined(HAVE_LLVM_BACKEND)
 runLlvmLlcPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
 runLlvmLlcPhase pipe_env hsc_env input_fn = do
     -- Note [Clamping of llc optimizations]
@@ -292,6 +308,7 @@ runLlvmOptPhase pipe_env hsc_env input_fn = do
                 )
 
     return output_fn
+#endif
 
 
 -- Run either 'clang' or 'gcc' phases
@@ -352,10 +369,12 @@ runGenericAsPhase run_as extra_opts with_cpp pipe_env hsc_env location input_fn
 
         return output_fn
 
+#if defined(HAVE_LLVM_BACKEND)
 -- Invoke `clang` to assemble a .S file produced by LLvm toolchain
 runLlvmAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
 runLlvmAsPhase =
   runGenericAsPhase runLlvmAs [ GHC.SysTools.Option "-Wno-unused-command-line-argument" ]
+#endif
 
 -- Invoke 'gcc' to assemble a .S file
 runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
@@ -976,6 +995,7 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
              | otherwise      = persistent
 
 
+#if defined(HAVE_LLVM_BACKEND)
 -- | LLVM Options. These are flags to be passed to opt and llc, to ensure
 -- consistency we list them in pairs, so that they form groups.
 llvmOptions :: LlvmConfig
@@ -1036,6 +1056,7 @@ llvmOptions llvm_config dflags =
                 ArchRISCV64 -> "lp64d"
                 ArchLoongArch64 -> "lp64d"
                 _           -> ""
+#endif
 
 -- | What phase to run after one of the backend code generators has run
 hscPostBackendPhase :: HscSource -> Backend -> Phase

compiler/GHC/Hs/Instances/Transitions.hs

@@ -22,7 +22,8 @@
 --
 -- See #9557 and #18254 for why we use -O0.
 {-# OPTIONS_GHC -O0 #-}
-{-# DEPRECATED "This module is empty; import the phase-specific GHC.Hs.Instances.* modules instead." #-}
+-- DEPRECATED: This module is empty; import the phase-specific
+-- GHC.Hs.Instances.* modules instead.
 
 module GHC.Hs.Instances.Transitions where
 

compiler/GHC/HsToCore.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE MonadComprehensions #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -35,7 +36,9 @@ import GHC.HsToCore.Binds
 import GHC.HsToCore.Foreign.Decl
 import GHC.HsToCore.Ticks
 import GHC.HsToCore.Breakpoints
+#if defined(HAVE_HPC)
 import GHC.HsToCore.Coverage
+#endif
 import GHC.HsToCore.Docs
 
 import GHC.Tc.Types
@@ -65,7 +68,9 @@ import GHC.Builtin.Types
 
 import GHC.Data.Maybe    ( expectJust )
 import GHC.Data.OrdList
+#if defined(HAVE_HPC)
 import GHC.Data.SizedSeq ( sizeSS )
+#endif
 
 import GHC.Utils.Error
 import GHC.Utils.Outputable
@@ -169,6 +174,7 @@ deSugar hsc_env
                 | otherwise
                 = Nothing
 
+#if defined(HAVE_HPC)
         ; ds_hpc_info <- case m_tickInfo of
             Just (orig_file2, ticks)
               | gopt Opt_Hpc $ hsc_dflags hsc_env
@@ -178,6 +184,9 @@ deSugar hsc_env
                 else return 0 -- dummy hash when none are written
               pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo
             _ -> pure $ emptyHpcInfo
+#else
+        ; let ds_hpc_info = emptyHpcInfo
+#endif
 
         ; (msgs, mb_res) <- initDs hsc_env tcg_env $
                        do { dsEvBinds ev_binds $ \ ds_ev_binds -> do
@@ -187,7 +196,9 @@ deSugar hsc_env
                           ; (ds_fords, foreign_prs) <- dsForeigns fords
                           ; ds_rules <- mapMaybeM dsRule rules
                           ; let hpc_init
+#if defined(HAVE_HPC)
                                   | gopt Opt_Hpc dflags = hpcInitCode (targetPlatform $ hsc_dflags hsc_env) mod ds_hpc_info
+#endif
                                   | otherwise = mempty
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs

compiler/GHC/Stg/Pipeline.hs

@@ -5,6 +5,7 @@
 -}
 
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -26,7 +27,9 @@ import GHC.Stg.Lint     ( lintStgTopBindings )
 import GHC.Stg.Stats    ( showStgStats )
 import GHC.Stg.FVs      ( depSortWithAnnotStgPgm )
 import GHC.Stg.Unarise  ( unarise )
+#if defined(HAVE_INTERPRETER)
 import GHC.Stg.BcPrep   ( bcPrep )
+#endif
 import GHC.Stg.CSE      ( stgCse )
 import GHC.Stg.Lift     ( StgLiftConfig, stgLiftLams )
 import GHC.Unit.Module ( Module )
@@ -136,10 +139,12 @@ stg2stg logger extra_vars opts this_mod binds
             let binds' = {-# SCC "StgLiftLams" #-} stgLiftLams this_mod cfg us binds
             end_pass "StgLiftLams" binds'
 
+#if defined(HAVE_INTERPRETER)
           StgBcPrep -> do
             us <- getUniqueSupplyM
             let binds' = {-# SCC "StgBcPrep" #-} bcPrep us binds
             end_pass "StgBcPrep" binds'
+#endif
 
           StgUnarise -> do
             us <- getUniqueSupplyM
@@ -173,8 +178,10 @@ data StgToDo
   | StgStats
   | StgUnarise
   -- ^ Mandatory unarise pass, desugaring unboxed tuple and sum binders
+#if defined(HAVE_INTERPRETER)
   | StgBcPrep
   -- ^ Mandatory when compiling to bytecode
+#endif
   | StgDoNothing
   -- ^ Useful for building up 'getStgToDo'
   deriving (Show, Read, Eq, Ord)