Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 66d1a5d5 by fendor at 2026-07-07T16:57:56-04:00 Add 'backendInfoTableMapValidity' backend predicate Check whether the backend supports the `-finfo-table-map` flag and ignore it otherwise. Improve by-design documentation of `backendCodeOutput`. `Backend` is **abstract by design**. Make this clearer in `backendCodeOutput` which is incorrectly being used as a proxy for `Backend`. Instead, define the desired property predicates in GHC.Driver.Backend In the process, make `backendCodeOutput` total. - - - - - 74f1071d by fendor at 2026-07-07T16:57:56-04:00 Add failing test for `-finfo-table-map` and bytecode backend If you compile a module using the bytecode backend, with -finfo-table-map, then the info table map doesn't get populated for the module. This is because the -finfo-table-map code path is implemented mostly in the StgToCmm phase which isn't run when creating bytecode. Ticket #27039 - - - - - 10 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - testsuite/tests/deSugar/should_fail/all.T - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/bytecodeIPE.hs - + testsuite/tests/ghci/scripts/bytecodeIPE.script - + testsuite/tests/ghci/scripts/bytecodeIPE.stdout Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -99,6 +99,7 @@ module GHC.Driver.Backend , backendPostHscPipeline , backendNormalSuccessorPhase , backendName + , backendInfoTableMapValidity , backendValidityOfCImport , backendValidityOfCExport @@ -117,7 +118,6 @@ import GHC.Driver.Phases import GHC.Utils.Error -import GHC.Utils.Panic import GHC.Driver.Pipeline.Monad import GHC.Platform @@ -368,7 +368,8 @@ data PrimitiveImplementation -- We expect one function per back end—or more precisely, one function -- for each back end that writes code to a file. (The interpreter -- does not write to files; its output lives only in memory.) - +-- +-- See Note [Backend Defunctionalization] data DefunctionalizedCodeOutput = NcgCodeOutput | ViaCCodeOutput @@ -680,6 +681,18 @@ backendSupportsBreakpoints = \case Named Bytecode -> True Named NoBackend -> False +-- | Return is 'IsValid' if the backend supports @-finfo-table-map@. +-- If 'backendInfoTableMapValidity' returns 'NotValid', then the driver ignores +-- the flag @-finfo-table-map@, since the backend doesn't support generating +-- the info table map. +backendInfoTableMapValidity :: Backend -> Validity' String +backendInfoTableMapValidity (Named NCG) = IsValid +backendInfoTableMapValidity (Named LLVM) = NotValid "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" +backendInfoTableMapValidity (Named ViaC) = IsValid +backendInfoTableMapValidity (Named JavaScript) = NotValid "-finfo-table-map is incompatible with the javascript backend" +backendInfoTableMapValidity (Named Bytecode) = IsValid -- We are not generating any objects, so @-finfo-table-map@ is not expected to work. Avoid warning for GHCi. +backendInfoTableMapValidity (Named NoBackend) = IsValid -- We are not generating code, so we ignore it any way + -- | If this flag is set, then the driver forces the -- optimization level to 0, issuing a warning message if -- the command line requested a higher optimization level. @@ -768,20 +781,33 @@ backendCDefs (Named NoBackend) = NoCDefs -- > -> Set UnitId -- ^ dependencies -- > -> Stream IO RawCmmGroup a -- results from `StgToCmm` -- > -> IO a -backendCodeOutput :: Backend -> DefunctionalizedCodeOutput -backendCodeOutput (Named NCG) = NcgCodeOutput -backendCodeOutput (Named LLVM) = LlvmCodeOutput -backendCodeOutput (Named ViaC) = ViaCCodeOutput -backendCodeOutput (Named JavaScript) = JSCodeOutput -backendCodeOutput (Named Bytecode) = panic "backendCodeOutput: bytecodeBackend" -backendCodeOutput (Named NoBackend) = panic "backendCodeOutput: noBackend" +-- +-- See Note [Backend Defunctionalization] +-- +-- === __WARNING__ +-- +-- Do NOT use 'backendCodeOutput' (or other functions in this module) as a +-- proxy for the 'Backend', which is __abstract by design__. +-- +-- If you need to determine some property of the backend, do NOT match on +-- 'DefunctionalizedCodeOutput'; Instead, write a new property predicate in +-- this module. This makes it easier to add new backends because essentially +-- all backend properties depended upon throughout the compiler are all found +-- here. +backendCodeOutput :: Backend -> Maybe DefunctionalizedCodeOutput +backendCodeOutput (Named NCG) = Just NcgCodeOutput +backendCodeOutput (Named LLVM) = Just LlvmCodeOutput +backendCodeOutput (Named ViaC) = Just ViaCCodeOutput +backendCodeOutput (Named JavaScript) = Just JSCodeOutput +backendCodeOutput (Named Bytecode) = Nothing +backendCodeOutput (Named NoBackend) = Nothing backendUseJSLinker :: Backend -> Bool backendUseJSLinker (Named NCG) = False backendUseJSLinker (Named LLVM) = False backendUseJSLinker (Named ViaC) = False backendUseJSLinker (Named JavaScript) = True -backendUseJSLinker (Named Bytecode) = False +backendUseJSLinker (Named Bytecode) = False backendUseJSLinker (Named NoBackend) = False -- | This (defunctionalized) function tells the compiler ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -4,7 +4,6 @@ \section{Code output phase} -} - module GHC.Driver.CodeOutput ( codeOutput , outputForeignStubs @@ -50,7 +49,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 ( panic, pgmError ) import GHC.Unit import GHC.Unit.Finder ( mkStubPaths ) @@ -124,11 +123,12 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ; let dus1 = newTagDUniqSupply CodeGenTag dus0 ; (stubs, a) <- case backendCodeOutput (backend dflags) of - NcgCodeOutput -> outputAsm logger dflags this_mod location filenm dus1 - final_stream - ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps - LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream - JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream + Just NcgCodeOutput -> outputAsm logger dflags this_mod location filenm dus1 + final_stream + Just ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps + Just LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream + Just JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs ; return (filenm, stubs_exist, foreign_fps, a) } ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -670,7 +670,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do -- next withTiming after this will be "Assembler" (hard code only). withTiming logger (text "CodeGen"<+>brackets (ppr this_mod)) (const ()) $ case backendCodeOutput (backend dflags) of - JSCodeOutput -> + Just JSCodeOutput -> do let js_config = initStgToJSConfig dflags @@ -696,7 +696,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do stgToJS logger js_config stg_binds this_mod spt_entries foreign_stubs0 cost_centre_info output_filename return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, Just cmm_cg_infos) - _ -> + Just _ -> do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv tycons @@ -724,6 +724,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do foreign_stubs foreign_files dependencies (initDUniqSupply 'n' 0) rawcmms1 return ( output_filename, stub_c_exists, foreign_fps , Just stg_cg_infos, Just cmm_cg_infos) + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" -- The part of CgGuts that we need for HscInteractive ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -741,7 +741,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env case backendCodeOutput (backend dflags) of - JSCodeOutput -> do + Just JSCodeOutput -> do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let src = ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode src)) @@ -750,7 +750,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do _ <- runPipeline (hsc_hooks hsc_env) pipeline pure () - _ -> do + Just _ -> do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" let src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode src)) @@ -758,6 +758,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline pure () + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -276,7 +276,7 @@ import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import GHC.Utils.Error (emptyDiagOpts, logInfo) +import GHC.Utils.Error (emptyDiagOpts, logInfo, Validity'(..)) import GHC.Settings import GHC.CmmToAsm.CFG.Weight import GHC.Core.Opt.CallerCC @@ -3855,8 +3855,8 @@ makeDynFlagsConsistent dflags && os == OSMinGW32 && arch == ArchAArch64 = case backendCodeOutput (backend dflags) of - LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64" - NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64" + Just LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64" + Just NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64" _ -> (dflags, mempty, mempty) -- When we do ghci, force using dyn ways if the target RTS linker @@ -3902,9 +3902,8 @@ makeDynFlagsConsistent dflags in dflags_c | gopt Opt_InfoTableMap dflags - , LlvmCodeOutput <- backendCodeOutput (backend dflags) - = loop (gopt_unset dflags Opt_InfoTableMap) - "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" + , NotValid msg <- backendInfoTableMapValidity (backend dflags) + = loop (gopt_unset dflags Opt_InfoTableMap) msg | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") ===================================== testsuite/tests/deSugar/should_fail/all.T ===================================== @@ -6,7 +6,9 @@ test('DsStrictFail', exit_code(1), compile_and_run, ['']) test( 'T21701', - [omit_ways(llvm_ways)], # -finfo-table-map does not work with -fllvm (#26435) + [ omit_ways(llvm_ways), # -finfo-table-map does not work with -fllvm (#26435) + when(js_arch(), skip) # javascript doesn't support -finfo-table-map yet and yields a warning we don't want to handle here + ], compile, ['-Wall -finfo-table-map'] ) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -385,6 +385,14 @@ test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script']) test('ListTuplePunsPprNoAbbrevTuple', [limit_stdout_lines(14)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script']) test('T24459', normal, ghci_script, ['T24459.script']) test('T24632', normal, ghci_script, ['T24632.script']) +# bytecode backend doesn't support '-finfo-table-map' (#27039) +test('bytecodeIPE', + [ extra_hc_opts('-finfo-table-map') + , extra_files(['bytecodeIPE.hs']) + , req_rts_linker + , when(arch('wasm32') or arch('javascript'), skip) + ], + ghci_script, ['bytecodeIPE.script']) # Test package renaming in GHCi session test('GhciPackageRename', ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.hs ===================================== @@ -0,0 +1,12 @@ +module BytecodeIPE where + +import Data.Maybe (isJust) +import GHC.InfoProv (whereFrom) + +marker :: String +marker = id "bytecode-stub-init" +{-# NOINLINE marker #-} + +-- `whereFrom` only succeeds if the module's IPE initializer ran. +probe :: IO Bool +probe = isJust <$> whereFrom marker ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.script ===================================== @@ -0,0 +1,2 @@ +:load bytecodeIPE.hs +probe ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stdout ===================================== @@ -0,0 +1 @@ +False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/383ddcd4fd1e54ac2ddcdd42bdc7805... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/383ddcd4fd1e54ac2ddcdd42bdc7805... You're receiving this email because of your account on gitlab.haskell.org.