Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC Commits: fb57793a by fendor at 2026-03-16T15:33:57+01:00 Avoid `panic` during `hscRecompStatus` - - - - - 2 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Unit/Module/Status.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -865,7 +865,7 @@ hscRecompStatus | otherwise -> do -- Check the status of all the linkable types we might need. -- 1. The in-memory linkable we had at hand. - bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeModLinkableByteCode old_linkable) + bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeMod_bytecode old_linkable) -- 2. The bytecode object file bc_obj_linkable <- checkByteCodeFromObject hsc_env mod_summary -- 3. Bytecode from an interface's whole core bindings. @@ -984,23 +984,22 @@ checkObjects dflags mb_old_linkable summary = do -- | Check to see if we can reuse the old linkable, by this point we will -- have just checked that the old interface matches up with the source hash, so -- no need to check that again here -checkByteCodeInMemory :: HscEnv -> ModSummary -> Maybe Linkable -> IO (MaybeValidated Linkable) +checkByteCodeInMemory :: HscEnv -> ModSummary -> Maybe (LinkableWith ModuleByteCode) -> IO (MaybeValidated (LinkableWith ModuleByteCode)) checkByteCodeInMemory hsc_env mod_sum mb_old_linkable = case mb_old_linkable of Just old_linkable - | not (linkableIsNativeCodeOnly old_linkable) -- If `-fwrite-byte-code` is enabled, then check that the .gbc file is -- up-to-date with the linkable we have in our hand. -- If ms_bytecode_date is Nothing, then the .gbc file does not exist yet. -- Otherwise, check that the date matches the linkable date exactly. - , if gopt Opt_WriteByteCode (hsc_dflags hsc_env) + | if gopt Opt_WriteByteCode (hsc_dflags hsc_env) then maybe False (linkableTime old_linkable ==) (ms_bytecode_date mod_sum) else True -> return $ (UpToDateItem old_linkable) _ -> return $ outOfDateItemBecause MissingBytecode Nothing -- | Load bytecode from a ".gbc" object file if it exists and is up-to-date -checkByteCodeFromObject :: HscEnv -> ModSummary -> IO (MaybeValidated Linkable) +checkByteCodeFromObject :: HscEnv -> ModSummary -> IO (MaybeValidated (LinkableWith ModuleByteCode)) checkByteCodeFromObject hsc_env mod_sum = do let obj_fn = ml_bytecode_file (ms_location mod_sum) @@ -1013,7 +1012,7 @@ checkByteCodeFromObject hsc_env mod_sum = do -- that the one we have on disk would be suitable as well. linkable <- unsafeInterleaveIO $ do bco <- ByteCode.readBinByteCode hsc_env obj_fn - return $ mkModuleByteCodeLinkable obj_date bco + return $ mkOnlyModuleByteCodeLinkable obj_date bco return $ UpToDateItem linkable _ -> return $ outOfDateItemBecause MissingBytecode Nothing ===================================== compiler/GHC/Unit/Module/Status.hs ===================================== @@ -18,12 +18,11 @@ import GHC.Unit.Home.ModInfo import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface -import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly, ModuleByteCode, LinkableWith, linkableModuleByteCodes ) +import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly, ModuleByteCode, LinkableWith ) import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Stack.Types (HasCallStack) -- | Status of a module in incremental compilation data HscRecompStatus @@ -84,14 +83,9 @@ emptyRecompLinkables = RecompLinkables (NormalLinkable Nothing) Nothing safeCastHomeModLinkable :: HomeModLinkable -> RecompLinkables safeCastHomeModLinkable (HomeModLinkable bc o) = RecompLinkables (NormalLinkable bc) o -justBytecode :: Either Linkable WholeCoreBindingsLinkable -> RecompLinkables +justBytecode :: Either (LinkableWith ModuleByteCode) WholeCoreBindingsLinkable -> RecompLinkables justBytecode = \case - Left lm -> - let - mbc = expectSingletonGbcLinkable lm - in - assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm) - $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just mbc) } + Left lm -> emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just lm) } Right lm -> emptyRecompLinkables { recompLinkables_bytecode = WholeCoreBindingsLinkable lm } justObjects :: Linkable -> RecompLinkables @@ -99,20 +93,11 @@ justObjects lm = assertPpr (linkableIsNativeCodeOnly lm) (ppr lm) $ emptyRecompLinkables { recompLinkables_object = Just lm } -bytecodeAndObjects :: Either Linkable WholeCoreBindingsLinkable -> Linkable -> RecompLinkables +bytecodeAndObjects :: Either (LinkableWith ModuleByteCode) WholeCoreBindingsLinkable -> Linkable -> RecompLinkables bytecodeAndObjects either_bc o = case either_bc of Left bc -> - let - mbc = expectSingletonGbcLinkable bc - in - assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o) - $ RecompLinkables (NormalLinkable (Just mbc)) (Just o) + assertPpr (linkableIsNativeCodeOnly o) (ppr o) + $ RecompLinkables (NormalLinkable (Just bc)) (Just o) Right bc -> assertPpr (linkableIsNativeCodeOnly o) (ppr o) $ RecompLinkables (WholeCoreBindingsLinkable bc) (Just o) - -expectSingletonGbcLinkable :: HasCallStack => Linkable -> LinkableWith ModuleByteCode -expectSingletonGbcLinkable lm = case linkableModuleByteCodes lm of - [] -> pprPanic "Expected 1 DotGBC in Linkable" (ppr lm) - [mbc] -> mbc <$ lm - _ -> pprPanic "Expected 1 DotGBC in Linkable" (ppr lm) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb57793ae31c0ae06ae986752c7c9ec1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb57793ae31c0ae06ae986752c7c9ec1... You're receiving this email because of your account on gitlab.haskell.org.