Simon Peyton Jones pushed to branch wip/24279 at Glasgow Haskell Compiler / GHC Commits: b253013e by Georgios Karachalias at 2025-11-07T17:21:57-05:00 Remove the `CoreBindings` constructor from `LinkablePart` Adjust HscRecompStatus to disallow unhydrated WholeCoreBindings from being passed as input to getLinkDeps (which would previously panic in this case). Fixes #26497 - - - - - ac7b737e by Sylvain Henry at 2025-11-07T17:22:51-05:00 Testsuite: pass ext-interp test way (#26552) Note that some tests are still marked as broken with the ext-interp way (see #26552 and #14335) - - - - - b44163d3 by Simon Peyton Jones at 2025-11-10T16:44:15+00:00 Make TYPE and CONSTRAINT apart again This patch finally fixes #24279. * The story started with #11715 * Then #21623 articulated a plan, which made Type and Constraint not-apart; a horrible hack but it worked. The main patch was commit 778c6adca2c995cd8a1b84394d4d5ca26b915dac Author: Simon Peyton Jones <simonpj@microsoft.com> Date: Wed Nov 9 10:33:22 2022 +0000 Type vs Constraint: finally nailed * #24279 reported a bug in the above big commit; this small patch fixes it commit af6932d6c068361c6ae300d52e72fbe13f8e1f18 Author: Simon Peyton Jones <simon.peytonjones@gmail.com> Date: Mon Jan 8 10:49:49 2024 +0000 Make TYPE and CONSTRAINT not-apart Issue #24279 showed up a bug in the logic in GHC.Core.Unify.unify_ty which is supposed to make TYPE and CONSTRAINT be not-apart. * Then !10479 implemented "unary classes". * That change in turn allows us to make Type and Constraint apart again, cleaning up the compiler and allowing a little bit more expressiveness. It fixes the original hope in #24279, namely that `Type` and `Constraint` should be distinct throughout. - - - - - 25 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/RoughMap.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Unit/Home/ModInfo.hs - compiler/GHC/Unit/Module/Status.hs - compiler/GHC/Unit/Module/WholeCoreBindings.hs - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/driver/T20696/all.T - testsuite/tests/driver/fat-iface/all.T - testsuite/tests/indexed-types/should_fail/T21092.hs - − testsuite/tests/indexed-types/should_fail/T21092.stderr - testsuite/tests/indexed-types/should_fail/all.T - testsuite/tests/splice-imports/all.T - testsuite/tests/typecheck/should_fail/T24279.hs - − testsuite/tests/typecheck/should_fail/T24279.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -752,8 +752,9 @@ Specifically (a ~# b) :: CONSTRAINT (TupleRep []) Wrinkles -(W1) Type and Constraint are considered distinct throughout GHC. But they - are not /apart/: see Note [Type and Constraint are not apart] +(W1) Type and Constraint are considered distinct throughout GHC. + That wasn't always the case: + see Historical Note [Type and Constraint are not apart] (W2) We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for types of kind Constraint. @@ -768,8 +769,24 @@ Wrinkles of type TYPE rr. See (CPR2) in Note [Which types are unboxed?] in GHC.Core.Opt.WorkWrap.Utils. -Note [Type and Constraint are not apart] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +------------------------------------------------------------- +Historical Note [Type and Constraint are not apart] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Nov 2025: + In the past, Type and Constraint were carefully coonsiderd to be + not /apart/. But the necessity for that vanished with unary classes + (see Note [Unary class magic]), done in + + commit 9bd7fcc518111a1549c98720c222cdbabd32ed46 + Author: Simon Peyton Jones <simon.peytonjones@gmail.com> + Date: Tue Apr 15 17:43:46 2025 +0100 + Implement unary classes + + So now Type and Constraint are simply distinct type constructors, just as + much as Int and Bool. + + The rest of this Note is preserved for historical interest. + Type and Constraint are not equal (eqType) but they are not /apart/ either. Reason (c.f. #7451): @@ -841,6 +858,9 @@ Wrinkles So in GHC.Tc.Instance.Class.matchTypeable, Type and Constraint are treated as separate TyCons; i.e. given no special treatment. +End of Historical Note +------------------------------------------------------------- + Note [RuntimeRep polymorphism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Generally speaking, you can't be polymorphic in `RuntimeRep`. E.g ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -641,11 +641,6 @@ eqTyConRole tc -- | Given a coercion `co :: (t1 :: TYPE r1) ~ (t2 :: TYPE r2)` -- produce a coercion `rep_co :: r1 ~ r2` --- But actually it is possible that --- co :: (t1 :: CONSTRAINT r1) ~ (t2 :: CONSTRAINT r2) --- or co :: (t1 :: TYPE r1) ~ (t2 :: CONSTRAINT r2) --- or co :: (t1 :: CONSTRAINT r1) ~ (t2 :: TYPE r2) --- See Note [mkRuntimeRepCo] mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion mkRuntimeRepCo co = assert (isTYPEorCONSTRAINT k1 && isTYPEorCONSTRAINT k2) $ @@ -654,26 +649,6 @@ mkRuntimeRepCo co kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2 Pair k1 k2 = coercionKind kind_co -{- Note [mkRuntimeRepCo] -~~~~~~~~~~~~~~~~~~~~~~~~ -Given - class C a where { op :: Maybe a } -we will get an axiom - axC a :: (C a :: CONSTRAINT r1) ~ (Maybe a :: TYPE r2) -(See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim.) - -Then we may call mkRuntimeRepCo on (axC ty), and that will return - mkSelCo (SelTyCon 0 Nominal) (Kind (axC ty)) :: r1 ~ r2 - -So mkSelCo needs to be happy with decomposing a coercion of kind - CONSTRAINT r1 ~ TYPE r2 - -Hence the use of `tyConIsTYPEorCONSTRAINT` in the assertion `good_call` -in `mkSelCo`. See #23018 for a concrete example. (In this context it's -important that TYPE and CONSTRAINT have the same arity and kind, not -merely that they are not-apart; otherwise SelCo would not make sense.) --} - isReflCoVar_maybe :: Var -> Maybe Coercion -- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t) -- Works on all kinds of Vars, not just CoVars @@ -1305,8 +1280,7 @@ mkSelCo_maybe cs co , Just (tc2, tys2) <- splitTyConApp_maybe ty2 , let { len1 = length tys1 ; len2 = length tys2 } - = (tc1 == tc2 || (tyConIsTYPEorCONSTRAINT tc1 && tyConIsTYPEorCONSTRAINT tc2)) - -- tyConIsTYPEorCONSTRAINT: see Note [mkRuntimeRepCo] + = tc1 == tc2 && len1 == len2 && n < len1 && r == tyConRole (coercionRole co) tc1 n ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2891,13 +2891,9 @@ lint_branch ax_tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs hang (text "Inhomogeneous axiom") 2 (text "lhs:" <+> ppr lhs <+> dcolon <+> ppr lhs_kind $$ text "rhs:" <+> ppr rhs <+> dcolon <+> ppr rhs_kind) } - -- Type and Constraint are not Apart, so this test allows - -- the newtype axiom for a single-method class. Indeed the - -- whole reason Type and Constraint are not Apart is to allow - -- such axioms! --- these checks do not apply to newtype axioms lint_family_branch :: TyCon -> CoAxBranch -> LintM () +-- These checks do not apply to newtype axioms lint_family_branch fam_tc br@(CoAxBranch { cab_tvs = tvs , cab_eta_tvs = eta_tvs , cab_cvs = cvs ===================================== compiler/GHC/Core/RoughMap.hs ===================================== @@ -36,7 +36,6 @@ import GHC.Core.Type import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Builtin.Types.Prim( cONSTRAINTTyConName, tYPETyConName ) import Control.Monad (join) import Data.Data (Data) @@ -347,16 +346,7 @@ typeToRoughMatchTc ty roughMatchTyConName :: TyCon -> Name roughMatchTyConName tc - | tc_name == cONSTRAINTTyConName - = tYPETyConName -- TYPE and CONSTRAINT are not apart, so they must use - -- the same rough-map key. We arbitrarily use TYPE. - -- See Note [Type and Constraint are not apart] - -- wrinkle (W1) in GHC.Builtin.Types.Prim - | otherwise - = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) tc_name - where - tc_name = tyConName tc - + = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) (tyConName tc) -- | Trie of @[RoughMatchTc]@ -- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1421,8 +1421,6 @@ piResultTy ty arg = case piResultTy_maybe ty arg of Nothing -> pprPanic "piResultTy" (ppr ty $$ ppr arg) piResultTy_maybe :: Type -> Type -> Maybe Type --- We don't need a 'tc' version, because --- this function behaves the same for Type and Constraint piResultTy_maybe ty arg = case coreFullView ty of FunTy { ft_res = res } -> Just res ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Prelude import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Var.Set -import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey ) import GHC.Core.Type hiding ( getTvSubstEnv ) import GHC.Core.Coercion hiding ( getCvSubstEnv ) import GHC.Core.Predicate( scopedSort ) @@ -98,8 +97,6 @@ of ways. Here we summarise, but see Note [Specification of unification]. See Note [Apartness and type families] * MARInfinite (occurs check): See Note [Infinitary substitutions] - * MARTypeVsConstraint: - See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim * MARCast (obscure): See (KCU2) in Note [Kind coercions in Unify] @@ -997,16 +994,12 @@ data UnifyResultM a = Unifiable a -- the subst that unifies the types -- | Why are two types 'MaybeApart'? 'MARInfinite' takes precedence: -- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv --- As of Feb 2022, we never differentiate between MARTypeFamily and MARTypeVsConstraint; --- it's really only MARInfinite that's interesting here. +-- It's really only MARInfinite that's interesting here. data MaybeApartReason = MARTypeFamily -- ^ matching e.g. F Int ~? Bool | MARInfinite -- ^ matching e.g. a ~? Maybe a - | MARTypeVsConstraint -- ^ matching Type ~? Constraint or the arrow types - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - | MARCast -- ^ Very obscure. -- See (KCU2) in Note [Kind coercions in Unify] @@ -1015,13 +1008,11 @@ combineMAR :: MaybeApartReason -> MaybeApartReason -> MaybeApartReason -- See (UR1) in Note [Unification result] for why MARInfinite wins combineMAR MARInfinite _ = MARInfinite -- MARInfinite wins combineMAR MARTypeFamily r = r -- Otherwise it doesn't really matter -combineMAR MARTypeVsConstraint r = r combineMAR MARCast r = r instance Outputable MaybeApartReason where ppr MARTypeFamily = text "MARTypeFamily" ppr MARInfinite = text "MARInfinite" - ppr MARTypeVsConstraint = text "MARTypeVsConstraint" ppr MARCast = text "MARCast" instance Semigroup MaybeApartReason where @@ -1729,30 +1720,6 @@ unify_ty env ty1 ty2 kco ; unify_tc_app env tc1 tys1 tys2 } - -- TYPE and CONSTRAINT are not Apart - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - -- NB: at this point we know that the two TyCons do not match - | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1 - , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2 - , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) || - (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey) - = maybeApart MARTypeVsConstraint - -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim - -- Note [Type and Constraint are not apart] - - -- The arrow types are not Apart - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - -- wrinkle (W2) - -- NB1: at this point we know that the two TyCons do not match - -- NB2: In the common FunTy/FunTy case you might wonder if we want to go via - -- splitTyConApp_maybe. But yes we do: we need to look at those implied - -- kind argument in order to satisfy (Unification Kind Invariant) - | FunTy {} <- ty1 - , FunTy {} <- ty2 - = maybeApart MARTypeVsConstraint - -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim - -- Note [Type and Constraint are not apart] - where mb_tc_app1 = splitTyConApp_maybe ty1 mb_tc_app2 = splitTyConApp_maybe ty2 ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -277,6 +277,7 @@ import Data.Data hiding (Fixity, TyCon) import Data.Functor ((<&>)) import Data.List ( nub, isPrefixOf, partition ) import qualified Data.List.NonEmpty as NE +import Data.Traversable (for) import Control.Monad import Data.IORef import System.FilePath as FilePath @@ -850,11 +851,11 @@ hscRecompStatus if | not (backendGeneratesCode (backend lcl_dflags)) -> do -- No need for a linkable, we're good to go msg UpToDate - return $ HscUpToDate checked_iface emptyHomeModInfoLinkable + return $ HscUpToDate checked_iface emptyRecompLinkables | not (backendGeneratesCodeForHsBoot (backend lcl_dflags)) , IsBoot <- isBootSummary mod_summary -> do msg UpToDate - return $ HscUpToDate checked_iface emptyHomeModInfoLinkable + return $ HscUpToDate checked_iface emptyRecompLinkables -- Always recompile with the JS backend when TH is enabled until -- #23013 is fixed. @@ -883,7 +884,7 @@ hscRecompStatus let just_o = justObjects <$> obj_linkable bytecode_or_object_code - | gopt Opt_WriteByteCode lcl_dflags = justBytecode <$> definitely_bc + | gopt Opt_WriteByteCode lcl_dflags = justBytecode . Left <$> definitely_bc | otherwise = (justBytecode <$> maybe_bc) `choose` just_o @@ -900,13 +901,13 @@ 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_in_memory_linkable `choose` - bc_obj_linkable `choose` - bc_core_linkable + maybe_bc = (Left <$> bc_in_memory_linkable) `choose` + (Left <$> bc_obj_linkable) `choose` + (Right <$> bc_core_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 + then Left <$> definitely_bc else maybe_bc trace_if (hsc_logger hsc_env) @@ -1021,14 +1022,13 @@ 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. -checkByteCodeFromIfaceCoreBindings :: HscEnv -> ModIface -> ModSummary -> IO (MaybeValidated Linkable) +checkByteCodeFromIfaceCoreBindings :: HscEnv -> ModIface -> ModSummary -> IO (MaybeValidated WholeCoreBindingsLinkable) checkByteCodeFromIfaceCoreBindings _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 - return (UpToDateItem (Linkable if_date this_mod (NE.singleton (CoreBindings fi)))) + Just fi -> return $ UpToDateItem (Linkable if_date this_mod fi) _ -> return $ outOfDateItemBecause MissingBytecode Nothing -------------------------------------------------------------- @@ -1142,20 +1142,22 @@ initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> - Linkable -> - IO Linkable -initWholeCoreBindings hsc_env iface details (Linkable utc_time this_mod uls) = do - Linkable utc_time this_mod <$> mapM (go hsc_env) uls + RecompLinkables -> + IO HomeModLinkable +initWholeCoreBindings hsc_env iface details (RecompLinkables bc o) = do + bc' <- go bc + pure $ HomeModLinkable bc' o where - go hsc_env' = \case - CoreBindings wcb -> do + type_env = md_types details + + go :: RecompBytecodeLinkable -> IO (Maybe Linkable) + go (NormalLinkable l) = pure l + go (WholeCoreBindingsLinkable wcbl) = + fmap Just $ for wcbl $ \wcb -> do add_iface_to_hpt iface details hsc_env bco <- unsafeInterleaveIO $ - compileWholeCoreBindings hsc_env' type_env wcb - pure (DotGBC bco) - l -> pure l - - type_env = md_types details + compileWholeCoreBindings hsc_env type_env wcb + pure $ NE.singleton (DotGBC bco) -- | Hydrate interface Core bindings and compile them to bytecode. -- ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -109,6 +109,7 @@ import GHC.Unit.Env import GHC.Unit.Finder import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Status import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable @@ -249,8 +250,8 @@ compileOne' mHscMessage (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' }) + linkable' <- initWholeCoreBindings plugin_hsc_env iface details linkable + return $! HomeModInfo iface details linkable' where lcl_dflags = ms_hspp_opts summary location = ms_location summary @@ -759,7 +760,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 (ModIface, HomeModLinkable) +fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, RecompLinkables) 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 @@ -768,7 +769,7 @@ 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 (ModIface, HomeModLinkable) +hscPipeline :: P m => PipeEnv -> (HscEnv, ModSummary, HscRecompStatus) -> m (ModIface, RecompLinkables) hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do case hsc_recomp_status of HscUpToDate iface mb_linkable -> return (iface, mb_linkable) @@ -777,7 +778,7 @@ hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do hscBackendAction <- use (T_HscPostTc hsc_env_with_plugins mod_sum tc_result warnings mb_old_hash ) hscBackendPipeline pipe_env hsc_env_with_plugins mod_sum hscBackendAction -hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, HomeModLinkable) +hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, RecompLinkables) hscBackendPipeline pipe_env hsc_env mod_sum result = if backendGeneratesCode (backend (hsc_dflags hsc_env)) then do @@ -796,15 +797,15 @@ hscBackendPipeline pipe_env hsc_env mod_sum result = return res else case result of - HscUpdate iface -> return (iface, emptyHomeModInfoLinkable) - HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing NoStubs []) <*> pure emptyHomeModInfoLinkable + HscUpdate iface -> return (iface, emptyRecompLinkables) + HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing NoStubs []) <*> pure emptyRecompLinkables hscGenBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction - -> m (ModIface, HomeModLinkable) + -> m (ModIface, RecompLinkables) hscGenBackendPipeline pipe_env hsc_env mod_sum result = do let mod_name = moduleName (ms_mod mod_sum) src_flavour = (ms_hsc_src mod_sum) @@ -812,7 +813,7 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do (fos, miface, mlinkable, o_file) <- use (T_HscBackend pipe_env hsc_env mod_name src_flavour location result) final_fp <- hscPostBackendPipeline pipe_env hsc_env (ms_hsc_src mod_sum) (backend (hsc_dflags hsc_env)) (Just location) o_file final_linkable <- - case final_fp of + safeCastHomeModLinkable <$> case final_fp of -- No object file produced, bytecode or NoBackend Nothing -> return mlinkable Just o_fp -> do @@ -936,7 +937,7 @@ pipelineStart pipe_env hsc_env input_fn mb_phase = as :: P m => Bool -> m (Maybe FilePath) as use_cpp = asPipeline use_cpp pipe_env hsc_env Nothing input_fn - objFromLinkable (_, homeMod_object -> Just (Linkable _ _ (DotO lnk _ :| []))) = Just lnk + objFromLinkable (_, recompLinkables_object -> Just (Linkable _ _ (DotO lnk _ :| []))) = Just lnk objFromLinkable _ = Nothing fromPhase :: P m => Phase -> m (Maybe FilePath) ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Utils.Error import GHC.Unit.Env import GHC.Unit.Finder import GHC.Unit.Module -import GHC.Unit.Module.WholeCoreBindings import GHC.Unit.Home.ModInfo import GHC.Iface.Errors.Types @@ -206,10 +205,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do DotO file ForeignObject -> pure (DotO file ForeignObject) DotA fp -> panic ("adjust_ul DotA " ++ show fp) DotDLL fp -> panic ("adjust_ul DotDLL " ++ show fp) - DotGBC {} -> pure part - CoreBindings WholeCoreBindings {wcb_module} -> - pprPanic "Unhydrated core bindings" (ppr wcb_module) - + DotGBC {} -> pure part {- ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveTraversable #-} ----------------------------------------------------------------------------- -- @@ -30,7 +31,9 @@ module GHC.Linker.Types , PkgsLoaded -- * Linkable - , Linkable(..) + , Linkable + , WholeCoreBindingsLinkable + , LinkableWith(..) , mkModuleByteCodeLinkable , LinkablePart(..) , LinkableObjectSort (..) @@ -254,7 +257,7 @@ instance Outputable LoadedPkgInfo where -- | Information we can use to dynamically link modules into the compiler -data Linkable = Linkable +data LinkableWith parts = Linkable { linkableTime :: !UTCTime -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, @@ -263,9 +266,13 @@ data Linkable = Linkable , linkableModule :: !Module -- ^ The linkable module itself - , linkableParts :: NonEmpty LinkablePart + , linkableParts :: parts -- ^ Files and chunks of code to link. - } + } deriving (Functor, Traversable, Foldable) + +type Linkable = LinkableWith (NonEmpty LinkablePart) + +type WholeCoreBindingsLinkable = LinkableWith WholeCoreBindings type LinkableSet = ModuleEnv Linkable @@ -282,7 +289,7 @@ unionLinkableSet = plusModuleEnv_C go | linkableTime l1 > linkableTime l2 = l1 | otherwise = l2 -instance Outputable Linkable where +instance Outputable a => Outputable (LinkableWith a) where ppr (Linkable when_made mod parts) = (text "Linkable" <+> parens (text (show when_made)) <+> ppr mod) $$ nest 3 (ppr parts) @@ -318,11 +325,6 @@ data LinkablePart | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) - | CoreBindings WholeCoreBindings - -- ^ Serialised core which we can turn into BCOs (or object files), or - -- used by some other backend See Note [Interface Files with Core - -- Definitions] - | DotGBC ModuleByteCode -- ^ A byte-code object, lives only in memory. @@ -350,7 +352,6 @@ instance Outputable LinkablePart where ppr (DotA path) = text "DotA" <+> text path ppr (DotDLL path) = text "DotDLL" <+> text path ppr (DotGBC bco) = text "DotGBC" <+> ppr bco - ppr (CoreBindings {}) = text "CoreBindings" -- | Return true if the linkable only consists of native code (no BCO) linkableIsNativeCodeOnly :: Linkable -> Bool @@ -391,7 +392,6 @@ isNativeCode = \case DotA {} -> True DotDLL {} -> True DotGBC {} -> False - CoreBindings {} -> False -- | Is the part a native library? (.so/.dll) isNativeLib :: LinkablePart -> Bool @@ -400,7 +400,6 @@ isNativeLib = \case DotA {} -> True DotDLL {} -> True DotGBC {} -> False - CoreBindings {} -> False -- | Get the FilePath of linkable part (if applicable) linkablePartPath :: LinkablePart -> Maybe FilePath @@ -408,7 +407,6 @@ linkablePartPath = \case DotO fn _ -> Just fn DotA fn -> Just fn DotDLL fn -> Just fn - CoreBindings {} -> Nothing DotGBC {} -> Nothing -- | Return the paths of all object code files (.o, .a, .so) contained in this @@ -418,7 +416,6 @@ linkablePartNativePaths = \case DotO fn _ -> [fn] DotA fn -> [fn] DotDLL fn -> [fn] - CoreBindings {} -> [] DotGBC {} -> [] -- | Return the paths of all object files (.o) contained in this 'LinkablePart'. @@ -427,7 +424,6 @@ linkablePartObjectPaths = \case DotO fn _ -> [fn] DotA _ -> [] DotDLL _ -> [] - CoreBindings {} -> [] DotGBC bco -> gbc_foreign_files bco -- | Retrieve the compiled byte-code from the linkable part. @@ -444,12 +440,11 @@ linkableFilter f linkable = do Just linkable {linkableParts = new} linkablePartNative :: LinkablePart -> [LinkablePart] -linkablePartNative = \case - u@DotO {} -> [u] - u@DotA {} -> [u] - u@DotDLL {} -> [u] +linkablePartNative u = case u of + DotO {} -> [u] + DotA {} -> [u] + DotDLL {} -> [u] DotGBC bco -> [DotO f ForeignObject | f <- gbc_foreign_files bco] - _ -> [] linkablePartByteCode :: LinkablePart -> [LinkablePart] linkablePartByteCode = \case ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -963,11 +963,6 @@ matchTypeable clas [k,t] -- clas = Typeable | k `eqType` naturalTy = doTyLit knownNatClassName t | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t | k `eqType` charTy = doTyLit knownCharClassName t - - -- TyCon applied to its kind args - -- No special treatment of Type and Constraint; they get distinct TypeReps - -- see wrinkle (W4) of Note [Type and Constraint are not apart] - -- in GHC.Builtin.Types.Prim. | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)] , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks ===================================== compiler/GHC/Unit/Home/ModInfo.hs ===================================== @@ -3,13 +3,10 @@ module GHC.Unit.Home.ModInfo ( HomeModInfo (..) - , HomeModLinkable(..) + , HomeModLinkable (..) , homeModInfoObject , homeModInfoByteCode , emptyHomeModInfoLinkable - , justBytecode - , justObjects - , bytecodeAndObjects ) where @@ -18,11 +15,9 @@ import GHC.Prelude import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModDetails -import GHC.Linker.Types ( Linkable(..), linkableIsNativeCodeOnly ) +import GHC.Linker.Types ( Linkable ) import GHC.Utils.Outputable -import GHC.Utils.Panic - -- | Information about modules in the package being compiled data HomeModInfo = HomeModInfo @@ -68,22 +63,6 @@ data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable) instance Outputable HomeModLinkable where ppr (HomeModLinkable l1 l2) = ppr l1 $$ ppr l2 -justBytecode :: Linkable -> HomeModLinkable -justBytecode lm = - assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm) - $ emptyHomeModInfoLinkable { homeMod_bytecode = Just lm } - -justObjects :: Linkable -> HomeModLinkable -justObjects lm = - assertPpr (linkableIsNativeCodeOnly lm) (ppr lm) - $ emptyHomeModInfoLinkable { homeMod_object = Just lm } - -bytecodeAndObjects :: Linkable -> Linkable -> HomeModLinkable -bytecodeAndObjects bc o = - assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o) - (HomeModLinkable (Just bc) (Just o)) - - {- Note [Home module build products] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Unit/Module/Status.hs ===================================== @@ -1,22 +1,35 @@ +{-# LANGUAGE LambdaCase #-} + module GHC.Unit.Module.Status - ( HscBackendAction(..), HscRecompStatus (..) + ( HscBackendAction(..) + , HscRecompStatus (..) + , RecompLinkables (..) + , RecompBytecodeLinkable (..) + , emptyRecompLinkables + , justBytecode + , justObjects + , bytecodeAndObjects + , safeCastHomeModLinkable ) where import GHC.Prelude import GHC.Unit +import GHC.Unit.Home.ModInfo import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface +import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly ) + import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import GHC.Unit.Home.ModInfo +import GHC.Utils.Panic -- | Status of a module in incremental compilation data HscRecompStatus -- | Nothing to do because code already exists. - = HscUpToDate ModIface HomeModLinkable + = HscUpToDate ModIface RecompLinkables -- | 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. @@ -41,6 +54,16 @@ data HscBackendAction -- changed. } +-- | Linkables produced by @hscRecompStatus@. Might contain serialized core +-- which can be turned into BCOs (or object files), or used by some other +-- backend. See Note [Interface Files with Core Definitions]. +data RecompLinkables = RecompLinkables { recompLinkables_bytecode :: !RecompBytecodeLinkable + , recompLinkables_object :: !(Maybe Linkable) } + +data RecompBytecodeLinkable + = NormalLinkable !(Maybe Linkable) + | WholeCoreBindingsLinkable !WholeCoreBindingsLinkable + instance Outputable HscRecompStatus where ppr HscUpToDate{} = text "HscUpToDate" ppr HscRecompNeeded{} = text "HscRecompNeeded" @@ -48,3 +71,37 @@ instance Outputable HscRecompStatus where instance Outputable HscBackendAction where ppr (HscUpdate mi) = text "Update:" <+> (ppr (mi_module mi)) ppr (HscRecomp _ ml _mi _mf) = text "Recomp:" <+> ppr ml + +instance Outputable RecompLinkables where + ppr (RecompLinkables l1 l2) = ppr l1 $$ ppr l2 + +instance Outputable RecompBytecodeLinkable where + ppr (NormalLinkable lm) = text "NormalLinkable:" <+> ppr lm + ppr (WholeCoreBindingsLinkable lm) = text "WholeCoreBindingsLinkable:" <+> ppr lm + +emptyRecompLinkables :: RecompLinkables +emptyRecompLinkables = RecompLinkables (NormalLinkable Nothing) Nothing + +safeCastHomeModLinkable :: HomeModLinkable -> RecompLinkables +safeCastHomeModLinkable (HomeModLinkable bc o) = RecompLinkables (NormalLinkable bc) o + +justBytecode :: Either Linkable WholeCoreBindingsLinkable -> RecompLinkables +justBytecode = \case + Left lm -> + assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm) + $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just lm) } + Right lm -> emptyRecompLinkables { recompLinkables_bytecode = WholeCoreBindingsLinkable lm } + +justObjects :: Linkable -> RecompLinkables +justObjects lm = + assertPpr (linkableIsNativeCodeOnly lm) (ppr lm) + $ emptyRecompLinkables { recompLinkables_object = Just lm } + +bytecodeAndObjects :: Either Linkable WholeCoreBindingsLinkable -> Linkable -> RecompLinkables +bytecodeAndObjects either_bc o = case either_bc of + Left bc -> + assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o) + $ RecompLinkables (NormalLinkable (Just bc)) (Just o) + Right bc -> + assertPpr (linkableIsNativeCodeOnly o) (ppr o) + $ RecompLinkables (WholeCoreBindingsLinkable bc) (Just o) ===================================== compiler/GHC/Unit/Module/WholeCoreBindings.hs ===================================== @@ -130,6 +130,9 @@ data WholeCoreBindings = WholeCoreBindings , wcb_foreign :: IfaceForeign } +instance Outputable WholeCoreBindings where + ppr (WholeCoreBindings {}) = text "WholeCoreBindings" + {- Note [Foreign stubs and TH bytecode linking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/tests/all.T ===================================== @@ -80,7 +80,7 @@ test('length001', # excessive amounts of stack space. So we specifically set a low # stack limit and mark it as failing under a few conditions. [extra_run_opts('+RTS -K8m -RTS'), - expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']), + expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'ext-interp']), # JS doesn't support stack limit so the test sometimes passes just fine. Therefore the test is # marked as fragile. when(js_arch(), fragile(22921))], ===================================== testsuite/driver/testlib.py ===================================== @@ -352,6 +352,9 @@ def req_plugins( name, opts ): """ req_interp(name, opts) + # Plugins aren't supported with the external interpreter (#14335) + expect_broken_for(14335,['ext-interp'])(name,opts) + if config.cross: opts.skip = True ===================================== testsuite/tests/driver/T20696/all.T ===================================== @@ -1,4 +1,5 @@ test('T20696', [extra_files(['A.hs', 'B.hs', 'C.hs']) + , expect_broken_for(26552, ['ext-interp']) , unless(ghc_dynamic(), skip)], multimod_compile, ['A', '']) test('T20696-static', [extra_files(['A.hs', 'B.hs', 'C.hs']) , when(ghc_dynamic(), skip)], multimod_compile, ['A', '']) ===================================== testsuite/tests/driver/fat-iface/all.T ===================================== @@ -9,12 +9,12 @@ test('fat010', [req_th,extra_files(['THA.hs', 'THB.hs', 'THC.hs']), copy_files], # Check linking works when using -fbyte-code-and-object-code test('fat011', [req_th, extra_files(['FatMain.hs', 'FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatMain', '-fbyte-code-and-object-code -fprefer-byte-code']) # Check that we use interpreter rather than enable dynamic-too if needed for TH -test('fat012', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fprefer-byte-code']) +test('fat012', [req_th, expect_broken_for(26552, ['ext-interp']), unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fprefer-byte-code']) # Check that no objects are generated if using -fno-code and -fprefer-byte-code test('fat013', [req_th, req_bco, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code']) # When using interpreter should not produce objects test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script']) -test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) +test('fat015', [req_th, expect_broken_for(26552, ['ext-interp']), unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface']) test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])] , makefile_test, ['T22807']) test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])] ===================================== testsuite/tests/indexed-types/should_fail/T21092.hs ===================================== @@ -7,3 +7,5 @@ type family F a type instance F Type = Int type instance F Constraint = Bool + +-- Nov 2025: Type and Constraint are now Apart (#24279) ===================================== testsuite/tests/indexed-types/should_fail/T21092.stderr deleted ===================================== @@ -1,5 +0,0 @@ - -T21092.hs:8:15: error: [GHC-34447] - Conflicting family instance declarations: - F (*) = Int -- Defined at T21092.hs:8:15 - F Constraint = Bool -- Defined at T21092.hs:9:15 ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -107,7 +107,7 @@ test('T8368', normal, compile_fail, ['']) test('T8368a', normal, compile_fail, ['']) test('T8518', normal, compile_fail, ['']) test('T9036', normal, compile_fail, ['']) -test('T21092', normal, compile_fail, ['']) +test('T21092', normal, compile, ['']) # Now compiles fine test('T9167', normal, compile_fail, ['']) test('T9171', normal, compile_fail, ['']) test('T9097', normal, compile_fail, ['']) ===================================== testsuite/tests/splice-imports/all.T ===================================== @@ -9,7 +9,7 @@ test('SI03', [extra_files(["SI01A.hs"])], multimod_compile_fail, ['SI03', '-v0'] test('SI04', [extra_files(["SI01A.hs"])], multimod_compile, ['SI04', '-v0']) test('SI05', [extra_files(["SI01A.hs"])], multimod_compile_fail, ['SI05', '-v0']) test('SI06', [extra_files(["SI01A.hs"])], multimod_compile, ['SI06', '-v0']) -test('SI07', [unless(ghc_dynamic(), skip), extra_files(["SI05A.hs"])], multimod_compile, ['SI07', '-fwrite-interface -fno-code']) +test('SI07', [expect_broken_for(26552, ['ext-interp']), unless(ghc_dynamic(), skip), extra_files(["SI05A.hs"])], multimod_compile, ['SI07', '-fwrite-interface -fno-code']) # Instance tests test('SI08', [extra_files(["ClassA.hs", "InstanceA.hs"])], multimod_compile_fail, ['SI08', '-v0']) test('SI09', [extra_files(["ClassA.hs", "InstanceA.hs"])], multimod_compile, ['SI09', '-v0']) ===================================== testsuite/tests/typecheck/should_fail/T24279.hs ===================================== @@ -13,7 +13,7 @@ type G :: Type -> RuntimeRep -> Type type family G a where G (a b) = a --- Should be rejected +-- Now (Nov 2025) accepted foo :: (F (G Constraint)) -> Bool foo x = x @@ -22,10 +22,10 @@ type family H a b where H a a = Int H a b = Bool --- Should be rejected -bar1 :: H TYPE CONSTRAINT -> Int +-- Now (Nov 2025) accepted +bar1 :: H TYPE CONSTRAINT -> Bool bar1 x = x --- Should be rejected -bar2 :: H Type Constraint -> Int +-- Now (Nov 2025) accepted +bar2 :: H Type Constraint -> Bool bar2 x = x ===================================== testsuite/tests/typecheck/should_fail/T24279.stderr deleted ===================================== @@ -1,19 +0,0 @@ - -T24279.hs:18:9: error: [GHC-83865] - • Couldn't match type ‘F CONSTRAINT’ with ‘Bool’ - Expected: Bool - Actual: F (G Constraint) - • In the expression: x - In an equation for ‘foo’: foo x = x - -T24279.hs:27:10: error: [GHC-83865] - • Couldn't match expected type ‘Int’ - with actual type ‘H TYPE CONSTRAINT’ - • In the expression: x - In an equation for ‘bar1’: bar1 x = x - -T24279.hs:31:10: error: [GHC-83865] - • Couldn't match expected type ‘Int’ - with actual type ‘H (*) Constraint’ - • In the expression: x - In an equation for ‘bar2’: bar2 x = x ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -718,7 +718,7 @@ test('T24064', normal, compile_fail, ['']) test('T24090a', normal, compile_fail, ['']) test('T24090b', normal, compile, ['']) # scheduled to become an actual error in GHC 9.16 test('T24298', normal, compile_fail, ['']) -test('T24279', normal, compile_fail, ['']) +test('T24279', normal, compile, ['']) # Now accepted (Nov 2025) test('T24318', normal, compile_fail, ['']) # all the various do expansion fail messages View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b211ff84d9a34fb60b51188d479b1b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b211ff84d9a34fb60b51188d479b1b... You're receiving this email because of your account on gitlab.haskell.org.