Matthew Pickering pushed to branch wip/gdc-files at Glasgow Haskell Compiler / GHC Commits: 64a09647 by Matthew Pickering at 2025-08-18T14:35:00+01:00 fixes - - - - - 12 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Unit/Module/Status.hs - testsuite/driver/testlib.py - testsuite/tests/driver/T5313.hs - testsuite/tests/ghc-api/T10052/T10052.hs - testsuite/tests/ghc-api/T8639_api.hs - testsuite/tests/ghc-api/apirecomp001/myghc.hs - testsuite/tests/ghci/linking/dyn/T3372.hs - testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T - testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T - testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -849,15 +849,14 @@ hscRecompStatus return $ HscRecompNeeded $ fmap mi_iface_hash mb_checked_iface UpToDateItem checked_iface -> do let lcl_dflags = ms_hspp_opts mod_summary - mod_details <- initModDetails hsc_env checked_iface if | not (backendGeneratesCode (backend lcl_dflags)) -> do -- No need for a linkable, we're good to go msg UpToDate - return $ HscUpToDate (HomeModInfo checked_iface mod_details emptyHomeModInfoLinkable) + return $ HscUpToDate checked_iface emptyHomeModInfoLinkable | not (backendGeneratesCodeForHsBoot (backend lcl_dflags)) , IsBoot <- isBootSummary mod_summary -> do msg UpToDate - return $ HscUpToDate (HomeModInfo checked_iface mod_details emptyHomeModInfoLinkable) + return $ HscUpToDate checked_iface emptyHomeModInfoLinkable -- Always recompile with the JS backend when TH is enabled until -- #23013 is fixed. @@ -874,7 +873,7 @@ hscRecompStatus -- 2. The bytecode object file bc_obj_linkable <- checkByteCodeFromObject hsc_env mod_summary -- 3. Bytecode from an interface whole core bindings. - bc_core_linkable <- checkByteCodeFromCoreBindings hsc_env checked_iface mod_details mod_summary + bc_core_linkable <- checkByteCodeFromCoreBindings hsc_env checked_iface mod_summary -- 4. The object file. obj_linkable <- liftIO $ checkObjects lcl_dflags (homeMod_object old_linkable) mod_summary trace_if (hsc_logger hsc_env) @@ -885,7 +884,7 @@ hscRecompStatus let just_o = justObjects <$> obj_linkable - definitely_both_os = case (definitely_bc, obj_linkable) of + definitely_both_os = case (bc_result, obj_linkable) of (UpToDateItem bc, UpToDateItem o) -> UpToDateItem (bytecodeAndObjects bc o) -- If missing object code, just say we need to recompile because of object code. (_, OutOfDateItem reason _) -> OutOfDateItem reason Nothing @@ -898,17 +897,26 @@ hscRecompStatus definitely_bc = bc_obj_linkable `prefer` bc_in_memory_linkable -- If not -fwrite-byte-code, then we could use core bindings or object code if that's available. - maybe_bc = ((bc_obj_linkable `choose` bc_core_linkable) `prefer` bc_in_memory_linkable) - `choose` obj_linkable + maybe_bc = bc_in_memory_linkable `choose` + bc_obj_linkable `choose` + bc_core_linkable `choose` + obj_linkable + bc_result = if gopt Opt_WriteByteCode lcl_dflags + -- If the byte-code artifact needs to be produced, then we certainly need bytecode. + then definitely_bc + else maybe_bc + + trace_if (hsc_logger hsc_env) + (vcat [text "definitely_bc", ppr definitely_bc + , text "maybe_bc", ppr maybe_bc + , text "definitely_both_os", ppr definitely_both_os + , text "just_o", ppr just_o]) -- pprTraceM "recomp" (ppr just_bc <+> ppr just_o) -- 2. Decide which of the products we will need let recomp_linkable_result = case () of _ | backendCanReuseLoadedCode (backend lcl_dflags) -> - if gopt Opt_WriteByteCode lcl_dflags - -- If the byte-code artifact needs to be produced, then we certainly need bytecode. - then justBytecode <$> definitely_bc - else justBytecode <$> maybe_bc + justBytecode <$> bc_result -- Need object files for making object files | backendWritesFiles (backend lcl_dflags) -> if gopt Opt_ByteCodeAndObjectCode lcl_dflags @@ -921,7 +929,7 @@ hscRecompStatus case recomp_linkable_result of UpToDateItem linkable -> do msg $ UpToDate - return $ HscUpToDate (HomeModInfo checked_iface mod_details linkable) + return $ HscUpToDate checked_iface linkable OutOfDateItem reason _ -> do msg $ NeedsRecompile reason return $ HscRecompNeeded $ Just $ mi_iface_hash $ checked_iface @@ -1010,19 +1018,20 @@ checkByteCodeFromObject hsc_env mod_sum = do -- | Attempt to load bytecode from whole core bindings in the interface if they exist. -- This is a legacy code-path, these days it should be preferred to use the bytecode object linkable. -checkByteCodeFromCoreBindings :: HscEnv -> ModIface -> ModDetails -> ModSummary -> IO (MaybeValidated Linkable) -checkByteCodeFromCoreBindings hsc_env iface mod_details mod_sum = do +checkByteCodeFromCoreBindings :: HscEnv -> ModIface -> ModSummary -> IO (MaybeValidated Linkable) +checkByteCodeFromCoreBindings _hsc_env iface mod_sum = do let this_mod = ms_mod mod_sum if_date = fromJust $ ms_iface_date mod_sum case iface_core_bindings iface (ms_location mod_sum) of Just fi -> do - ~(bco, fos) <- unsafeInterleaveIO $ - compileWholeCoreBindings hsc_env (md_types mod_details) fi - let bco' = LazyBCOs bco fos - return $ UpToDateItem (Linkable if_date this_mod (NE.singleton bco')) + return $ UpToDateItem (Linkable if_date this_mod (NE.singleton (CoreBindings fi))) _ -> return $ outOfDateItemBecause MissingBytecode Nothing +-- 970 let fi = WholeCoreBindings extra_decls this_mod (ms_location mod_sum) +-- 971 (mi_foreign iface) +-- 972 return (UpToDateItem (Linkable if_date this_mod (NE.singleton (CoreBindings fi)))) + -------------------------------------------------------------- -- Compilers -------------------------------------------------------------- ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -244,11 +244,11 @@ compileOne' mHscMessage status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary mb_old_iface mb_old_linkable (mod_index, nmods) let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, upd_summary, status) - runPipeline (hsc_hooks plugin_hsc_env) pipeline + (iface, linkable) <- runPipeline (hsc_hooks plugin_hsc_env) pipeline -- See Note [ModDetails and --make mode] - -- details <- initModDetails plugin_hsc_env iface - -- linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable) - -- return $! HomeModInfo iface details (linkable { homeMod_bytecode = linkable' }) + details <- initModDetails plugin_hsc_env iface + linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable) + return $! HomeModInfo iface details (linkable { homeMod_bytecode = linkable' }) where lcl_dflags = ms_hspp_opts summary location = ms_location summary @@ -757,7 +757,7 @@ preprocessPipeline pipe_env hsc_env input_fn = do $ phaseIfFlag hsc_env flag def action -- | The complete compilation pipeline, from start to finish -fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m HomeModInfo +fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, HomeModLinkable) fullPipeline pipe_env hsc_env pp_fn src_flavour = do (dflags, input_fn) <- preprocessPipeline pipe_env hsc_env pp_fn let hsc_env' = hscSetFlags dflags hsc_env @@ -766,16 +766,15 @@ fullPipeline pipe_env hsc_env pp_fn src_flavour = do hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) -- | Everything after preprocess -hscPipeline :: P m => PipeEnv -> ((HscEnv, ModSummary, HscRecompStatus)) -> m HomeModInfo +hscPipeline :: P m => PipeEnv -> ((HscEnv, ModSummary, HscRecompStatus)) -> m (ModIface, HomeModLinkable) hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do case hsc_recomp_status of - HscUpToDate hmi -> return hmi + HscUpToDate iface linkable -> return (iface, linkable) HscRecompNeeded mb_old_hash -> do (tc_result, warnings) <- use (T_Hsc hsc_env_with_plugins mod_sum) hscBackendAction <- use (T_HscPostTc hsc_env_with_plugins mod_sum tc_result warnings mb_old_hash ) (iface, linkable) <-hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction - details <- liftIO $ initModDetails hsc_env_with_plugins iface - return $! HomeModInfo iface details linkable + return $! (iface, linkable) hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, HomeModLinkable) hscBackendPipeline pipe_env hsc_env mod_sum result = @@ -924,7 +923,7 @@ pipelineStart pipe_env hsc_env input_fn mb_phase = liftIO (showPass logger msg) liftIO (copyWithHeader line_prag out_fn final_fn) return Nothing - _ -> objFromLinkable . hm_linkable <$> fullPipeline pipe_env hsc_env input_fn sf + _ -> objFromLinkable . snd <$> fullPipeline pipe_env hsc_env input_fn sf c :: P m => Phase -> m (Maybe FilePath) c phase = viaCPipeline phase pipe_env hsc_env Nothing input_fn as :: P m => Bool -> m (Maybe FilePath) ===================================== compiler/GHC/Unit/Module/Status.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Unit.Home.ModInfo -- | Status of a module in incremental compilation data HscRecompStatus -- | Nothing to do because code already exists. - = HscUpToDate HomeModInfo + = HscUpToDate ModIface HomeModLinkable -- | Recompilation of module, or update of interface is required. Optionally -- pass the old interface hash to avoid updating the existing interface when -- it has not changed. ===================================== testsuite/driver/testlib.py ===================================== @@ -549,10 +549,12 @@ only_ghci = only_ways([WayName('ghci'), WayName('ghci-opt')]) # ----- def valid_way( way: WayName ) -> bool: - if way in {'ghci', 'ghci-opt', 'ghci-ext'}: + if way in {'ghci', 'ghci-opt'}: return config.have_RTS_linker - if way == 'ghci-ext-prof': - return config.have_RTS_linker and config.have_profiling + if way in {'ghci-ext'}: + return config.have_ext_interp + if way in {'ghci-ext-prof'}: + return config.have_ext_interp and config.have_profiling return True def extra_ways( ways: List[WayName] ): ===================================== testsuite/tests/driver/T5313.hs ===================================== @@ -7,7 +7,7 @@ main = do -- begin initialize df0 <- GHC.getSessionDynFlags let df1 = df0{GHC.ghcMode = GHC.CompManager, - GHC.backend = GHC.interpreterBackend, + GHC.backend = GHC.bytecodeBackend, GHC.ghcLink = GHC.LinkInMemory, GHC.verbosity = 0} _ <- GHC.setSessionDynFlags df1 ===================================== testsuite/tests/ghc-api/T10052/T10052.hs ===================================== @@ -24,7 +24,7 @@ runGhc' args act = do logger <- getLogger (dflags1, _leftover, _warns) <- parseDynamicFlags logger dflags0 flags let dflags2 = dflags1 { - backend = interpreterBackend + backend = bytecodeBackend , ghcLink = LinkInMemory , verbosity = 1 } ===================================== testsuite/tests/ghc-api/T8639_api.hs ===================================== @@ -11,7 +11,7 @@ main = do { [libdir] <- getArgs ; runGhc (Just libdir) $ do flags <- getSessionDynFlags - setSessionDynFlags (flags{ backend = interpreterBackend, ghcLink = LinkInMemory}) + setSessionDynFlags (flags{ backend = bytecodeBackend, ghcLink = LinkInMemory}) target <- guessTarget "T8639_api_a.hs" Nothing Nothing setTargets [target] load LoadAllTargets ===================================== testsuite/tests/ghc-api/apirecomp001/myghc.hs ===================================== @@ -37,7 +37,7 @@ main = do prn "target nothing: ok" dflags <- getSessionDynFlags - setSessionDynFlags $ dflags { backend = interpreterBackend } + setSessionDynFlags $ dflags { backend = bytecodeBackend } ok <- load LoadAllTargets when (failed ok) $ error "Couldn't load A.hs in interpreted mode" prn "target interpreted: ok" ===================================== testsuite/tests/ghci/linking/dyn/T3372.hs ===================================== @@ -44,7 +44,7 @@ newGhcServer = do (libdir:_) <- getArgs where ghc action libdir = GHC.runGhc (Just libdir) (init >> action) init = do df <- GHC.getSessionDynFlags GHC.setSessionDynFlags df{GHC.ghcMode = GHC.CompManager, - GHC.backend = GHC.interpreterBackend, + GHC.backend = GHC.bytecodeBackend, GHC.ghcLink = GHC.LinkInMemory, GHC.verbosity = 0} ===================================== testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T ===================================== @@ -2,9 +2,8 @@ test('PackedDataCon', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + extra_ways(ghci_ways), + only_ways(ghci_ways), ], compile_and_run, [''] ===================================== testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T ===================================== @@ -1,10 +1,11 @@ +print(ghci_ways) + test('UnboxedTuples', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + only_ways(ghci_ways), + extra_ways(ghci_ways), ], compile_and_run, [''] ===================================== testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T ===================================== @@ -2,9 +2,8 @@ test('UnliftedDataTypeInterp', [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']), req_interp, req_bco, - extra_ways(['ghci']), - when(config.have_ext_interp, extra_ways(['ghci', 'ghci-ext'])), - when(config.have_ext_interp and config.have_profiling, extra_ways(['ghci', 'ghci-ext', 'ghci-ext-prof'])) + only_ways(ghci_ways), + extra_ways(ghci_ways), ], compile_and_run, [''] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64a0964734a4572c63aa49eb1d026cff... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64a0964734a4572c63aa49eb1d026cff... You're receiving this email because of your account on gitlab.haskell.org.