Teo Camarasu pushed to branch wip/T26226 at Glasgow Haskell Compiler / GHC Commits: 846ab130 by Teo Camarasu at 2025-07-25T21:35:00+01:00 ghci: always enable the internal-interpreter flag Building iserv requires the modules hidden behind the ghci internal-interpreter flag. This flag exists because these modules depend on parts of the TemplateHaskell interface, and historically we couldn't distinguish between the boot and the in-tree TH interface. This meant that these modules could only be built in stage0 if we've ensured that the boot TH interface matches the in-tree one. This restriction no longer holds as of https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12306. Removing this flag simplifies our logic, and is a step towards enabling using TH in bootstrapping (https://gitlab.haskell.org/ghc/ghc/-/issues/24624). - - - - - 14a6e7d6 by Teo Camarasu at 2025-07-25T21:35:00+01:00 compiler: rename ghciSuported -> internalInterpreterSupported GHCi and the internal interpreter are two different things. This tracks support for the latter. You can use GHCi without the internal interpreter. - - - - - 260db985 by Teo Camarasu at 2025-07-25T21:35:00+01:00 ghcBin: rename internal-interpreter flag to ghci This flag controls whether we include the ghci interface, ie, --interactive mode in the ghc executable. This is orthogonal to whether we support the internal interpreter. We can use GHCi with the external interpreter. - - - - - 9 changed files: - cabal.project-reinstall - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Utils/Constants.hs - ghc/GHC/Driver/Session/Mode.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== cabal.project-reinstall ===================================== @@ -56,7 +56,7 @@ packages: ./compiler ./linters/**/*.cabal constraints: ghc +internal-interpreter +dynamic-system-linke, - ghc-bin +internal-interpreter +threaded, + ghc-bin +ghci +threaded, ghci +internal-interpreter, haddock +in-ghc-tree, any.array installed, ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -1010,7 +1010,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically -- turn on -fexternal-interpreter. - ext_interp_enable ms = not ghciSupported && internalInterpreter + ext_interp_enable ms = not internalInterpreterSupported && internalInterpreter where lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) ===================================== compiler/GHC/Utils/Constants.hs ===================================== @@ -2,7 +2,7 @@ module GHC.Utils.Constants ( debugIsOn - , ghciSupported + , internalInterpreterSupported , isWindowsHost , isDarwinHost ) @@ -22,11 +22,11 @@ branch of the conditional, thereby dropping debug code altogether when the flags are off. -} -ghciSupported :: Bool +internalInterpreterSupported :: Bool #if defined(HAVE_INTERNAL_INTERPRETER) -ghciSupported = True +internalInterpreterSupported = True #else -ghciSupported = False +internalInterpreterSupported = False #endif debugIsOn :: Bool ===================================== ghc/GHC/Driver/Session/Mode.hs ===================================== @@ -134,7 +134,7 @@ isDoEvalMode :: Mode -> Bool isDoEvalMode (Right (Right (DoEval _))) = True isDoEvalMode _ = False -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) isInteractiveMode :: PostLoadMode -> Bool isInteractiveMode DoInteractive = True isInteractiveMode _ = False ===================================== ghc/Main.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Platform import GHC.Platform.Host -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif @@ -289,7 +289,7 @@ doRun units srcs args = do args' = drop 1 $ dropWhile (/= "--") $ map unLoc args ghciUI :: [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () -#if !defined(HAVE_INTERNAL_INTERPRETER) +#if !defined(HAVE_GHCI) ghciUI _ _ _ = throwGhcException (CmdLineError "not built for interactive use") #else @@ -333,7 +333,7 @@ showBanner :: PostLoadMode -> DynFlags -> IO () showBanner _postLoadMode dflags = do let verb = verbosity dflags -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) -- Show the GHCi banner when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg #endif ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -17,8 +17,8 @@ Category: Development Build-Type: Simple Cabal-Version: >=1.10 -Flag internal-interpreter - Description: Build with internal interpreter support. +Flag ghci + Description: Build with support for GHCi. Default: False Manual: True @@ -56,7 +56,7 @@ Executable ghc -rtsopts=all "-with-rtsopts=-K512M -H -I5 -T" - if flag(internal-interpreter) + if flag(ghci) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq >= 1.4 && < 1.6, @@ -65,7 +65,7 @@ Executable ghc haskeline == 0.8.*, exceptions == 0.10.*, time >= 1.8 && < 1.15 - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + CPP-Options: -DHAVE_GHCI Other-Modules: GHCi.Leak GHCi.UI ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -25,10 +25,6 @@ packageArgs = do -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling - -- Check if the bootstrap compiler has the same version as the one we - -- are building. This is used to build cross-compilers - bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1 - compilerStageOption f = buildingCompilerStage' . f =<< expr flavour cursesIncludeDir <- getSetting CursesIncludeDir @@ -128,39 +124,9 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ - -- The use case here is that we want to build @iserv-proxy@ for the - -- cross compiler. That one needs to be compiled by the bootstrap - -- compiler as it needs to run on the host. Hence @iserv@ needs - -- @GHCi.TH@, @GHCi.Message@, @GHCi.Run@, and @GHCi.Server@ from - -- @ghci@. And those are behind the @-finternal-interpreter@ flag. - -- - -- But it may not build if we have made some changes to ghci's - -- dependencies (see #16051). - -- - -- To fix this properly Hadrian would need to: - -- * first build a compiler for the build platform (stage1 is enough) - -- * use it as a bootstrap compiler to build the stage1 cross-compiler - -- - -- The issue is that "configure" would have to be executed twice (for - -- the build platform and for the cross-platform) and Hadrian would - -- need to be fixed to support two different stage1 compilers. - -- - -- The workaround we use is to check if the bootstrap compiler has - -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with - -- `-finternal-interpreter`. - -- - -- TODO: Note that in that case we also do not need to build most of - -- the Stage1 libraries, as we already know that the bootstrap - -- compiler comes with the same versions as the one we are building. - -- - builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir + [ builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir , builder (Cabal Flags) ? mconcat - [ ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") - , stage0 `cabalFlag` "bootstrap" + [ stage0 `cabalFlag` "bootstrap" ] ] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -260,7 +260,11 @@ sandboxIO opts io = do -- rethrow :: EvalOpts -> IO a -> IO a rethrow EvalOpts{..} io = +#if MIN_VERSION_base(4,21,0) catchNoPropagate io $ \(ExceptionWithContext cx se) -> do +#else + catch io $ \se -> do +#endif -- If -fbreak-on-error, we break unconditionally, -- but with care of not breaking twice if breakOnError && not breakOnException @@ -271,7 +275,11 @@ rethrow EvalOpts{..} io = Just UserInterrupt -> return () -- In any other case, we don't want to break _ -> poke exceptionFlag 0 +#if MIN_VERSION_base(4,21,0) rethrowIO (ExceptionWithContext cx se) +#else + throwIO se +#endif -- -- While we're waiting for the sandbox thread to return a result, if ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,11 +17,6 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag internal-interpreter - Description: Build with internal interpreter support. - Default: False - Manual: True - Flag bootstrap Description: Enabled when building the stage1 compiler in order to vendor the in-tree @@ -56,23 +51,19 @@ library TupleSections UnboxedTuples - if flag(internal-interpreter) - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + if !arch(javascript) exposed-modules: - GHCi.Run - GHCi.Debugger - GHCi.CreateBCO - GHCi.ObjLink - GHCi.Signals - GHCi.StaticPtrTable - GHCi.TH - GHCi.Server - - if !arch(javascript) - exposed-modules: - GHCi.InfoTable + GHCi.InfoTable exposed-modules: + GHCi.Run + GHCi.Debugger + GHCi.CreateBCO + GHCi.ObjLink + GHCi.Signals + GHCi.StaticPtrTable + GHCi.TH + GHCi.Server GHCi.BreakArray GHCi.BinaryArray GHCi.Message View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44cdfa931f541242796c37d099d0a26... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44cdfa931f541242796c37d099d0a26... You're receiving this email because of your account on gitlab.haskell.org.