- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/rafl/hpc-instances] hpc: Improve coverage semantics for instance methods and instances
by Florian Ragwitz (＠rafl) 12 Oct '26

12 Oct '26

Florian Ragwitz pushed to branch wip/rafl/hpc-instances at Glasgow Haskell Compiler / GHC Commits: 80aca549 by Florian Ragwitz at 2026-10-11T17:08:42-07:00 hpc: Improve coverage semantics for instance methods and instances Users care about which of their explicitly written methods are or aren't covered, not whether all of the inherited methods are covered as well. Those should be covered where they are implemented. We therefore skip generating top-level boxes for inherited methods which will appear as uncovered with no clear indication as to why, and no way to fix other than exercising code the user has not written. Previously, top-level boxes for those inherited methods would use the instance head as their source span. Now that those boxes are gone, we can use that source span for another purpose: We introduce a new top-level box for each class instance with its instance head as the source span, and use that to indicate whether or not an instance has been covered at all. We do this by making any method of the instance, inherited/generated or otherwise, tick the box for the instance head. Excluded from this are methodless classes, which could never be covered using the current mechanism. This could be improved upon further. These changes apply to ticking for program coverage only, and don't affect source notes. Additionally, we update the scope of record selector ticking to be limited to program coverage as well, as the oversight to also extend it to source notes has previously caused bugs and because record selector ticking is coverage-specific. Fixes #17155, #15932. - - - - - 12 changed files: - + changelog.d/hpc-classinsts - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Id/Info.hs - + testsuite/tests/hpc/instmeths/instmeths.hs - + testsuite/tests/hpc/instmeths/instmeths.stdout - + testsuite/tests/hpc/instmeths/test.T - testsuite/tests/simplCore/should_compile/T22375.stderr - testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr Changes: ===================================== changelog.d/hpc-classinsts ===================================== @@ -0,0 +1,23 @@ +section: compiler +synopsis: Improve coverage reporting for class instances and their methods +description: + + Coverage reporting (:ghc-flag:`-fhpc`) now treats class instances more + naturally. + + Compiler-generated instance methods, such as inherited default methods, no + longer receive separate top-level coverage boxes. Explicitly implemented + instance methods retain their own declaration coverage. + + This means that it is no longer necessary to exercise all of a class' methods + in order for it to appear "covered". + + Additionally, top-level coverage boxes are now created for all instances of + classes with methods, and ticked by the use of *any* of the class' methods. + This indicates that an instance was in fact used at run-time. + + Note that classes without any instance methods are currently excluded from + this, and won't have any coverage boxes created. + +mrs: !16632 +issues: #17155 #15932 ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -3082,6 +3082,7 @@ wantCallsFor _env f JoinId {} -> True WorkerLikeId {} -> True RepPolyId {} -> True + InstMethId {} -> True interestingDict :: SpecEnv -> CoreExpr -> Bool -- This is a subtle and important function ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -454,6 +454,7 @@ toIfaceTopBndr id toIfaceIdDetails :: Name -- ^ for trace/panic messages only -> IdDetails -> IfaceIdDetails toIfaceIdDetails _ VanillaId = IfVanillaId +toIfaceIdDetails _ (InstMethId {}) = IfVanillaId toIfaceIdDetails _ (WorkerLikeId dmds) = IfWorkerLikeId dmds toIfaceIdDetails _ (DFunId {}) = IfDFunId toIfaceIdDetails _ (RecSelId { sel_naughty = n ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -170,7 +170,8 @@ deSugar hsc_env (hsc_logger hsc_env) (initTicksConfig (hsc_dflags hsc_env)) mod mod_loc - export_set (typeEnvTyCons type_env) binds + export_set (typeEnvTyCons type_env) + insts binds else return (binds, Nothing) ; let modBreaks | Just (_, _, breakpointSpecs) <- m_tickInfo ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1,11 +1,11 @@ -{-# LANGUAGE NondecreasingIndentation, DataKinds #-} +{-# LANGUAGE NondecreasingIndentation, DataKinds, ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {- (c) Galois, 2006 (c) University of Glasgow, 2007 -(c) Florian Ragwitz, 2025 +(c) Florian Ragwitz, 2025-2026 -} module GHC.HsToCore.Ticks @@ -24,6 +24,8 @@ import GHC.Unit import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.InstEnv +import GHC.Core.Class import GHC.Data.Maybe import GHC.Data.FastString @@ -43,6 +45,7 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Name.Set import GHC.Types.Name +import GHC.Types.Name.Env import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Tickish @@ -56,6 +59,7 @@ import Data.Foldable (toList) import Trace.Hpc.Mix import Data.Bifunctor (second) +import Data.Functor import Data.List.NonEmpty (NonEmpty (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -100,11 +104,12 @@ addTicksToBinds -- isExportedId doesn't work yet (the desugarer -- hasn't set it), so we have to work from this set. -> [TyCon] -- ^ Type constructors in this module + -> [ClsInst] -- ^ Class instances in this module -> LHsBinds GhcTc -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick)) addTicksToBinds logger cfg - mod mod_loc exports tyCons binds + mod mod_loc exports tyCons insts binds | let passes = ticks_passes cfg , not (null passes) , Just orig_file <- ml_hs_file mod_loc = do @@ -129,8 +134,13 @@ addTicksToBinds logger cfg , this_mod = mod , tickishType = tickish , recSelBinds = emptyVarEnv + , instMeths = emptyVarEnv + , instTicks = emptyNameEnv } - (binds',_,st') = unTM (addTickLHsBinds binds) env st + addTick = do + instTicks <- allocInstTicks insts + withEnv (\e -> e{ instTicks }) $ addTickLHsBinds binds + (binds',_,st') = unTM addTick env st in (binds', st') (binds1,st) = foldr tickPass (binds, initTTState) passes @@ -231,7 +241,7 @@ addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc) addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds , abs_exports = abs_exports }))) = - withEnv (add_rec_sels . add_inlines . add_exports) $ do + withEnv (add_inst_meths . add_rec_sels . add_inlines . add_exports) $ do binds' <- addTickLHsBinds binds return $ L pos $ XHsBindsLR $ bind { abs_binds = binds' } where @@ -259,19 +269,26 @@ addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds | ABE{ abe_poly, abe_mono } <- abs_exports , RecSelId{} <- [idDetails abe_poly] ] } + add_inst_meths env = + env{ instMeths = instMeths env `extendVarEnvList` + [ (abe_mono, dfun) + | ABE{ abe_poly, abe_mono } <- abs_exports + , Just dfun <- [instMeth abe_poly] ] } + where instMeth (idDetails -> InstMethId dfun) = Just dfun + instMeth id = lookupVarEnv (instMeths env) id + addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches }))) = do let name = getOccString id decl_path <- getPathEntry density <- getDensity + env <- getEnv - inline_ids <- liftM inlines getEnv -- See Note [inline sccs] let inline = isInlinePragma (idInlinePragma id) - || id `elemVarSet` inline_ids + || id `elemVarSet` inlines env -- See Note [inline sccs] - tickish <- tickishType `liftM` getEnv - case tickish of { ProfNotes | inline -> return (L pos funBind); _ -> do + case tickishType env of { ProfNotes | inline -> return (L pos funBind); _ -> do -- See Note [Record-selector ticks] selTicks <- recSelTick id @@ -294,16 +311,28 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches toplev = null decl_path exported = idName id `elemNameSet` exported_names - tick <- if not blackListed && - shouldTickBind density toplev exported simple inline + -- See Note [Instance Method Coverage]. + -- We only exclude generated instance methods for now, not generated code in + -- general, whose coverage semantics may need to be considered separately. + let generatedInstMeth = tickishType env == HpcTicks + && id `elemVarEnv` instMeths env + && isGenerated (mg_origin (mg_ext matches)) + + tick <- if not generatedInstMeth + && not blackListed + && shouldTickBind density toplev exported simple inline then bindTick density name (locA pos) fvs else return Nothing + -- See Note [Instance Method Coverage]. + instTick <- instMethTick id + let mbCons = maybe Prelude.id (:) return $ L pos $ funBind { fun_matches = mg - , fun_ext = second (tick `mbCons`) (fun_ext funBind) } + , fun_ext = second ((instTick `mbCons`) . (tick `mbCons`)) + (fun_ext funBind) } } } where -- See Note [Record-selector ticks] @@ -338,6 +367,30 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches -- This scheme could be extended further in the future, making coverage for -- positional constructor fields mean that the field was accessed at run-time. +-- Note [Instance Method Coverage] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Users expect source-level semantics for coverage reports (see #17155, +-- #15932). That is, code they've written themselves should be marked as covered +-- iff it is evaluated at run-time. Given that the implementation of class +-- instances creates top-level bindings for all methods of an instance, +-- inherited and hand-written, we need to go out of our way to create top-level +-- tick boxes only for methods which correspond to user-written code. +-- +-- Instance method 'Id's carry the name of the 'DFunId' of the instance they +-- belong to. When creating tick boxes for top-level bindings, we can use this +-- information to skip creating boxes for inherited/generated instance methods. +-- +-- Additionally, we also want to inform the user whether or not their class +-- instance as a whole has been used at run-time. To do so, we create a single +-- tick box at the instance head and tick that box when any method of that +-- instance is evaluated. +-- +-- As marker/tag-like class instances without any methods would always appear +-- as uncovered using the above mechanism, we exclude them when creating +-- instance tick boxes. This could potentially be improved in the future by +-- tracking if any functions requiring an instance of an empty class have been +-- evaluated. + -- TODO: Revisit this addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs , pat_rhs = rhs @@ -1098,6 +1151,8 @@ data TickTransEnv = TTE { fileName :: FastString , this_mod :: Module , tickishType :: TickishType , recSelBinds :: IdEnv DVarSet + , instMeths :: IdEnv Name + , instTicks :: NameEnv CoreTickish } -- deriving Show @@ -1182,6 +1237,9 @@ getDensity = TM $ \env st -> (density env, noFVs, st) ifDensity :: TickDensity -> TM a -> TM a -> TM a ifDensity d th el = do d0 <- getDensity; if d == d0 then th else el +ifTickish :: TickishType -> TM a -> TM a -> TM a +ifTickish want th el = tickishType <$> getEnv >>= \got -> if want == got then th else el + getFreeVars :: TM a -> TM (FreeVars, a) getFreeVars (TM m) = TM $ \ env st -> case m env st of (a, fv, st') -> ((fv,a), fv, st') @@ -1238,6 +1296,20 @@ isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList isBlackListed GeneratedSrcSpan{} = return False isBlackListed UnhelpfulSpan{} = return False +-- See Note [Instance Method Coverage]. +allocInstTicks :: [ClsInst] -> TM (NameEnv CoreTickish) +allocInstTicks insts = + ifTickish HpcTicks (mkNameEnv . catMaybes <$> mapM alloc insts) (pure emptyNameEnv) + where + alloc ClsInst{ is_dfun, is_cls } + | null (classMethods is_cls) = pure Nothing + | otherwise = fmap (idName is_dfun,) <$> allocATickBox (TopLevelBox [getOccString is_dfun]) + False True (getSrcSpan is_dfun) noFVs + +-- See Note [Instance Method Coverage]. +instMethTick :: Id -> TM (Maybe CoreTickish) +instMethTick id = getEnv <&> \e -> lookupVarEnv (instMeths e) id >>= lookupNameEnv (instTicks e) + -- the tick application inherits the source position of its -- expression argument to support nested box allocations allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc) @@ -1256,7 +1328,7 @@ allocTickBox boxLabel countEntries topOnly pos m return (this_loc (XExpr $ HsTick tickish $ this_loc e)) recSelTick :: Id -> TM (Maybe [CoreTickish]) -recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing) +recSelTick id = ifTickish HpcTicks maybe_tick (pure Nothing) where maybe_tick = getEnv >>= maybe (pure Nothing) tick_all . (`lookupVarEnv` id) . recSelBinds ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -59,7 +59,7 @@ import GHC.Core.FamInstEnv import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.InstEnv -import GHC.Core.Predicate( classMethodInstTy ) +import GHC.Core.Predicate( classMethodInstTy, isCoVarType ) import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.DataCon @@ -72,6 +72,7 @@ import GHC.Types.Var.Set import GHC.Types.Basic import GHC.Types.ForeignCall ( typeCheckCType ) import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.InlinePragma import GHC.Types.SourceFile import GHC.Types.SourceText @@ -1859,7 +1860,7 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys tc_item :: ClassOpItem -> TcM (Id, LHsBind GhcTc, Maybe Implication) tc_item (sel_id, dm_info) | Just (user_bind, bndr_loc, prags) <- findMethodBind (idName sel_id) binds prag_fn - = tcMethodBody False clas tyvars dfun_ev_vars inst_tys + = tcMethodBody False dfun_id clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived hs_sig_fn spec_inst_prags prags sel_id user_bind bndr_loc @@ -1879,7 +1880,7 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys -- See Note [Implementation of Unsatisfiable constraints], -- in GHC.Tc.Errors, point (D). _ | (theta_id,unsat_msg) : _ <- unsat_thetas - -> do { (meth_id, _) <- mkMethIds clas tyvars dfun_ev_vars + -> do { (meth_id, _) <- mkMethIds dfun_id clas tyvars dfun_ev_vars inst_tys sel_id ; unsat_id <- tcLookupKnownKeyId unsatisfiableIdKey -- Recall that unsatisfiable :: forall {rep} (msg :: ErrorMessage) (a :: TYPE rep). Unsatisfiable msg => a @@ -1896,7 +1897,7 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys Just (dm_name, dm_spec) -> do { (meth_bind, inline_prags) <- mkDefMethBind inst_loc dfun_id clas sel_id dm_name dm_spec ; tcMethodBody (is_vanilla_dm dm_spec) - clas tyvars dfun_ev_vars inst_tys + dfun_id clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived hs_sig_fn spec_inst_prags inline_prags sel_id meth_bind inst_loc } @@ -1904,7 +1905,7 @@ tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys -- No default method Nothing -> do { traceTc "tc_def: warn" (ppr sel_id) - ; (meth_id, _) <- mkMethIds clas tyvars dfun_ev_vars + ; (meth_id, _) <- mkMethIds dfun_id clas tyvars dfun_ev_vars inst_tys sel_id ; dflags <- getDynFlags -- Add a binding whose RHS is an error @@ -2030,13 +2031,13 @@ Instead, we take the following approach: tcMethodBody :: Bool -- True <=> This is a vanilla default method -- See (TRC5) in Note [Tracking needed EvIds] -- in GHC.Tc.Solver.Solve - -> Class -> [TcTyVar] -> [EvVar] -> [TcType] + -> DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType] -> TcEvBinds -> Bool -> HsSigFun -> [LTcSpecPrag] -> [LSig GhcRn] -> Id -> LHsBind GhcRn -> SrcSpan -> TcM (TcId, LHsBind GhcTc, Maybe Implication) -tcMethodBody is_vanilla_dm clas tyvars dfun_ev_vars inst_tys +tcMethodBody is_vanilla_dm dfun_id clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived sig_fn spec_inst_prags prags sel_id (L bind_loc meth_bind) bndr_loc @@ -2044,7 +2045,7 @@ tcMethodBody is_vanilla_dm clas tyvars dfun_ev_vars inst_tys do { traceTc "tcMethodBody" (ppr sel_id <+> ppr (idType sel_id) $$ ppr bndr_loc) ; let skol_info = MethSkol meth_name is_vanilla_dm ; (global_meth_id, local_meth_id) <- setSrcSpan bndr_loc $ - mkMethIds clas tyvars dfun_ev_vars + mkMethIds dfun_id clas tyvars dfun_ev_vars inst_tys sel_id ; let lm_bind = meth_bind { fun_id = L (noAnnSrcSpan bndr_loc) @@ -2162,16 +2163,19 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind -- they are all for meth_id ------------------------ -mkMethIds :: Class -> [TcTyVar] -> [EvVar] +mkMethIds :: DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType] -> Id -> TcM (TcId, TcId) -- returns (poly_id, local_id), but ignoring any instance signature -- See Note [Instance method signatures] -mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id +mkMethIds dfun_id clas tyvars dfun_ev_vars inst_tys sel_id = do { poly_meth_name <- newName (mkClassOpAuxOcc sel_occ) ; local_meth_name <- newName sel_occ -- Base the local_meth_name on the selector name, because -- type errors from tcMethodBody come from here - ; let poly_meth_id = mkLocalId poly_meth_name ManyTy poly_meth_ty + ; let poly_meth_id = + assert (not (isCoVarType poly_meth_ty)) $ + Var.mkLocalVar (InstMethId (idName dfun_id)) + poly_meth_name ManyTy poly_meth_ty vanillaIdInfo local_meth_id = mkLocalId local_meth_name ManyTy local_meth_ty ; return (poly_meth_id, local_meth_id) } ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -222,6 +222,10 @@ data IdDetails -- - the [CbvMark] is always empty (and ignored) until after Tidy -- for ids from the current module -- - If non-empty, at least is isMarkedCbbv; see (CBV2) + | InstMethId + -- ^ An instance method. + Name + -- ^ 'Name' of the dictionary function the instance method belongs to. data RecSelInfo = RSI { rsi_def :: [ConLike] -- Record selector defined for these @@ -449,6 +453,7 @@ pprIdDetails other = brackets (pp other) ppWhen is_naughty (text "(naughty)") pp CoVarId = text "CoVarId" pp (JoinId arity marks) = text "JoinId" <> parens (int arity) <> parens (ppr marks) + pp (InstMethId name) = text "InstMethId" <> parens (ppr name) {- ************************************************************************ ===================================== testsuite/tests/hpc/instmeths/instmeths.hs ===================================== @@ -0,0 +1,57 @@ +import Data.List +import Data.Maybe +import Trace.Hpc.Mix +import Trace.Hpc.Reflect +import Trace.Hpc.Tix +import Trace.Hpc.Util + +class Foo a where + defMeth, defMeth', reqMeth :: a -> String + defMeth = const "class default" + defMeth' = const "class default" + +newtype T a = T a deriving (Show, Eq, Functor) +instance Foo (T a) where + reqMeth = const "Foo (T a) instance" + +newtype T' a = T' a + +instance Foo (T' a) where + reqMeth = const "Foo (T' a) instance" + defMeth = const "Foo (T' a) instance" + +-- no method use could "cover" this instance, so we (for now) omit the top-level box for it +class Marker a +instance Marker (T Bool) + +interesting :: (Int, MixEntry) -> Maybe (Int, HpcPos, String) +interesting (n, (pos, TopLevelBox [name])) | isInteresting name = Just (n, pos, name) + where isInteresting = (||) <$> isInst <*> isMeth + isInst = ("$f" `isPrefixOf`) + isMeth = (||) <$> (`elem` ["(==)", "(/=)", "show", "showList", "showsPrec", "fmap", "(<$)"]) + <*> ("Meth" `isInfixOf`) +interesting _ = Nothing + +-- candidate for HPC.Utils, maybe? +sourceAt :: String -> HpcPos -> String +sourceAt src pos + | l1 == l2 = take (c2 - c1 + 1) . drop (c1 - 1) $ ls !! (l1 - 1) + | otherwise = intercalate "\n" $ first : (middle ++ [last]) + where + (l1, c1, l2, c2) = fromHpcPos pos + ls = lines src + first = drop (c1 - 1) $ ls !! (l1 - 1) + middle = take (l2 - l1 - 1) $ drop l1 ls + last = take c2 $ ls !! (l2 - 1) + +main :: IO () +main = do + print (T 23 == (succ <$> T 22)) -- tick Eq and Functor by using any of their methods + print (reqMeth (T' 1)) -- tick `Foo (T' a)` and that instance's `reqMeth` + + Mix source _ _ _ mixEntries <- readMix [".hpc"] (Left "Main") + src <- readFileUtf8 source + let boxes = mapMaybe interesting $ zip [0 ..] mixEntries + Tix [TixModule "Main" _ _ counts] <- examineTix + mapM_ print [ (counts !! n, path, sourceAt src pos) + | (n, pos, path) <- sortOn (\(_, l, p) -> (p, l)) boxes ] ===================================== testsuite/tests/hpc/instmeths/instmeths.stdout ===================================== @@ -0,0 +1,12 @@ +True +"Foo (T' a) instance" +(1,"$fEqT","Eq") +(0,"$fFooT","Foo (T a)") +(1,"$fFooT'","Foo (T' a)") +(1,"$fFunctorT","Functor") +(0,"$fShowT","Show") +(0,"defMeth","defMeth = const \"class default\"") +(0,"defMeth","defMeth = const \"Foo (T' a) instance\"") +(0,"defMeth'","defMeth' = const \"class default\"") +(0,"reqMeth","reqMeth = const \"Foo (T a) instance\"") +(1,"reqMeth","reqMeth = const \"Foo (T' a) instance\"") ===================================== testsuite/tests/hpc/instmeths/test.T ===================================== @@ -0,0 +1,5 @@ +setTestOpts([omit_ghci, when(fast(), skip), js_skip]) + +test('instmeths', + [ignore_extension], + compile_and_run, ['-fhpc']) ===================================== testsuite/tests/simplCore/should_compile/T22375.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core -- RHS size: {terms: 14, types: 9, coercions: 0, joins: 0/0} T22375.$fEqX_$c== :: X -> X -> Bool -[GblId, +[GblId[InstMethId(T22375.$fEqX)], Arity=2, Str=<SL><SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, @@ -27,7 +27,7 @@ T22375.$fEqX_$c== -- RHS size: {terms: 18, types: 9, coercions: 0, joins: 0/0} T22375.$fEqX_$c/= [InlPrag=INLINE (sat-args=2)] :: X -> X -> Bool -[GblId, +[GblId[InstMethId(T22375.$fEqX)], Arity=2, Str=<SL><SL>, Unf=Unf{Src=StableUser, TopLvl=True, ===================================== testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core -- RHS size: {terms: 14, types: 11, coercions: 2, joins: 0/0} T22375DataFamily.$fEqX_$c== :: X () -> X () -> Bool -[GblId, +[GblId[InstMethId(T22375DataFamily.$fEqX)], Arity=2, Str=<SL><SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, @@ -36,7 +36,7 @@ T22375DataFamily.$fEqX_$c== -- RHS size: {terms: 18, types: 11, coercions: 2, joins: 0/0} T22375DataFamily.$fEqX_$c/= [InlPrag=INLINE (sat-args=2)] :: X () -> X () -> Bool -[GblId, +[GblId[InstMethId(T22375DataFamily.$fEqX)], Arity=2, Str=<SL><SL>, Unf=Unf{Src=StableUser, TopLvl=True, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80aca54961b995ce453eade7a872df6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80aca54961b995ce453eade7a872df6… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/rafl/hpc-instances] 14 commits: Simplify the error-suppression mechanism in GHC.Tc.Errors
by Florian Ragwitz (＠rafl) 12 Oct '26

12 Oct '26

Florian Ragwitz pushed to branch wip/rafl/hpc-instances at Glasgow Haskell Compiler / GHC Commits: 41e80f41 by Simon Peyton Jones at 2026-10-11T14:38:51-04:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In `GHC.Tc.Errors.reportWanteds` we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. Main changes * Instead of /predicting/ when an error will be reported, we set `cec_error_reported` when an error is /actually/ reported. (I renamed it from `cec_suppress` to reflect this change.) Now errors are suppressed only when a preceding error has actually been reported. Simpler and more robust. See `Note [cec_error_reported: suppressing less-serious errors]` The big changes are in `reportWanteds` which looks very different. * New `Note [ei_suppress: suppressing confusing errors]` describes the (quite separate) `ei_suppress` mechanism for suppressing confusing errors, mainly arising from non-empty rewriter sets * In `tryTypeClassDefaulting`, instead of switching off type-class defaulting if there is an insoluble /anywhere/, we just switch it off locally when we find an insoluble sub-tree. See Note [When to do type-class defaulting] and (W5) in Note [ApproximateWC] * Greatly simplify `insolubleWantedCt`. * I made type-class-defaulting be a bit more eager, only switched off when a peer or ancestor (but not child) constraint is insoluble. See Note [When to do type-class defaulting]. Small refactorings * Rename `askNoErrs` to `askErrsFound` and flip its polarity * The code for "check if ei_suppress is true of all items" code is moved to `mkErrorItems` rather than in the large `reportWanteds`. * Code for `has_gadt_match` moves to `mkGivenErrorReporter`, rather than polluting the large `reportWanteds`. * Many tests with `-fdefer-type-errors` get more warnings, especially about ambiguous (Num a) constraints. This is by-design: see Note [Always warn with -fdefer-type-errors]. Previously GHC was not honouring this Note but now it is, hence the extra errors. - - - - - f217fc31 by Cheng Shao at 2026-10-11T14:39:33-04:00 compiler: ensure cross ghc --info output target unit ids Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in --info output do not match the target unit ids reported by ghc-pkg, breaking cross ghc release builds with hash-unit-ids when being used with cabal 3.18. This patch fixes it by making --info output target unit ids. Fixes #27919. Co-authored-by: Codex <codex(a)openai.com> - - - - - 81963a1a by Florian Ragwitz at 2026-10-11T14:27:44-07:00 hpc: Test desired HPC behaviour for class instances - - - - - ae5f4094 by Florian Ragwitz at 2026-10-11T14:27:44-07:00 Extend TcGblEnv with a mapping from instance method Ids to DFunIds We want to use this in HPC to provide better support for instance methods. This is working towards #17155. - - - - - e2a574c1 by Florian Ragwitz at 2026-10-11T14:27:44-07:00 hpc: Do not create top-level boxes for generated instance methods Users care about which of their written methods are or aren't covered, not whether all of the inherited methods are covered as well. Those should be covered where they are implemented. We achieve that by stopping to generate top-level boxes which will often appear as uncovered with no clear indication as to why, and no way to fix other than excercising code the user has not written. Fixes #17155, #15932. - - - - - 184757bf by Florian Ragwitz at 2026-10-11T14:27:45-07:00 hpc: Provide coverage information for class instances After fixing #17155, we no longer create top-level boxes for the source spans of instance heads (previously that was the source span used for inherited/generated instance methods). With those boxes gone, we can introduce a new top-level box for each class instance with that instance head source span, and provide more meaningful coverage semantics for it. We make the use of any of the instance's methods (user-written or generated) tick this box, providing the programmer with useful information about whether or not the instance was exercised at run-time, and whether the instance might be unnecessary. - - - - - cd895b49 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 hpc: Don't allocate boxes for methodless classes With the plumbing we currently have, these could never be covered, which is not helpful to hpc users. This could be improved upon further. - - - - - f529b859 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 Add a changelog entry for new HPC features - - - - - 4f73a8f7 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 Remove tcg_inst_meths in favour of a new IdDetails constructor Thanks for this great suggestion, Sam! <3 - - - - - c5076948 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 Revert back to just using getOccString for DFunIds - - - - - 545ca654 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 Limit instance and instance method coverage to HPC only It's not useful for SourceNotes, which is the other tickishType included in TickForCoverage. - - - - - 2d5888b7 by Florian Ragwitz at 2026-10-11T14:27:45-07:00 Limit record selector ticking to HPC - - - - - a2fed92d by Florian Ragwitz at 2026-10-11T16:14:31-07:00 Clarify why we're not excluding all generated code (yet!) - - - - - 060670b3 by Florian Ragwitz at 2026-10-11T16:33:40-07:00 Minor documentation tweaks - - - - - 75 changed files: - .gitlab/hello.hs - + changelog.d/T27731 - + changelog.d/fix-cross-ghc-info-unit-id - + changelog.d/hpc-classinsts - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Id/Info.hs - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020b.stderr - testsuite/tests/ghci/prog021/prog021a.stderr - testsuite/tests/ghci/prog021/prog021b.stderr - testsuite/tests/ghci/prog022/ghci.prog022a.stderr - testsuite/tests/ghci/prog022/ghci.prog022b.stderr - testsuite/tests/ghci/prog022/ghci.prog022c.stderr - testsuite/tests/ghci/prog022/ghci.prog022d.stderr - testsuite/tests/ghci/prog022/ghci.prog022e.stderr - testsuite/tests/ghci/prog022/ghci.prog022f.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - + testsuite/tests/hpc/instmeths/instmeths.hs - + testsuite/tests/hpc/instmeths/instmeths.stdout - + testsuite/tests/hpc/instmeths/test.T - testsuite/tests/module/mod130.stderr - testsuite/tests/overloadedstrings/should_fail/T25926.stderr - testsuite/tests/overloadedstrings/should_fail/T27124.stderr - testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/rename/should_fail/T15607.stderr - testsuite/tests/rename/should_fail/T19843b.stderr - testsuite/tests/safeHaskell/ghci/p4.stderr - testsuite/tests/safeHaskell/ghci/p6.stderr - testsuite/tests/simplCore/should_compile/T22375.stderr - testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr - testsuite/tests/typecheck/should_compile/T11254.stderr - testsuite/tests/typecheck/should_compile/T15370.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/ClassOperator.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T18851f.hs - + testsuite/tests/typecheck/should_fail/T18851f.stderr - testsuite/tests/typecheck/should_fail/T22940.stderr - testsuite/tests/typecheck/should_fail/T26823.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/T5691.stderr - testsuite/tests/typecheck/should_fail/T7437.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/mc24.stderr - testsuite/tests/typecheck/should_fail/tcfail019.stderr - testsuite/tests/typecheck/should_fail/tcfail189.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c06dab642d8751ce1df02dedef2a3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c06dab642d8751ce1df02dedef2a3… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27724] 9 commits: Preserve sign of zero when parsing -0.0#
by Simon Peyton Jones (＠simonpj) 12 Oct '26

12 Oct '26

Simon Peyton Jones pushed to branch wip/T27724 at Glasgow Haskell Compiler / GHC Commits: ffa56ae4 by sheaf at 2026-10-09T17:15:59+02:00 Preserve sign of zero when parsing -0.0# This commit leverages the recently added GHC.Types.Literal.Floating module in order to preserve the sign of negative zero from source-written floating-point literals. Fixes #27545 - - - - - d538cac9 by Facundo Domínguez at 2026-10-09T20:26:38-04:00 Propagate annotations to simple interfaces This allows annotations to be visible to plugins when run by haddock. The LiquidHaskell plugin needs the annotations, in particular. Fixes #26761 - - - - - 32c4f4ab by meooow25 at 2026-10-09T20:27:28-04:00 Bump containers submodule to 0.8.1 And fix affected tests. * T4086a: containers depends on template-haskell-lift now instead of template-haskell. * T22611: Updated to be less dependent on containers internals. - - - - - c786065e by sheaf at 2026-10-09T20:28:20-04:00 Use an explicit pattern match in toIfaceIdDetails The old wildcard pattern let this code bit rot: it did not properly account for recently added 'IdDetails' such as 'RepPolyId', which resulted in spurious 'pprTrace' messages that could even pollute HLS sessions. Fixes #23785 - - - - - e7cacf59 by sheaf at 2026-10-09T20:29:09-04:00 Take into account ifKind in freeNamesIfDecl Commit 3c2f4bb4 added the 'ifKind' field to various constructors of 'IfaceDecl', which preserves the original kind (before type synonym expansion) for better error messages. However, that commit forgot to update 'freeNamesIfDecl' correspondingly. This could result in a "urk! lookup local fingerpring" crash when e.g. a type's kind uses a type synonym defined later, as we failed to add a dependency on the type synonym during dependency analysis. Fixes #27916 - - - - - 41e80f41 by Simon Peyton Jones at 2026-10-11T14:38:51-04:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In `GHC.Tc.Errors.reportWanteds` we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. Main changes * Instead of /predicting/ when an error will be reported, we set `cec_error_reported` when an error is /actually/ reported. (I renamed it from `cec_suppress` to reflect this change.) Now errors are suppressed only when a preceding error has actually been reported. Simpler and more robust. See `Note [cec_error_reported: suppressing less-serious errors]` The big changes are in `reportWanteds` which looks very different. * New `Note [ei_suppress: suppressing confusing errors]` describes the (quite separate) `ei_suppress` mechanism for suppressing confusing errors, mainly arising from non-empty rewriter sets * In `tryTypeClassDefaulting`, instead of switching off type-class defaulting if there is an insoluble /anywhere/, we just switch it off locally when we find an insoluble sub-tree. See Note [When to do type-class defaulting] and (W5) in Note [ApproximateWC] * Greatly simplify `insolubleWantedCt`. * I made type-class-defaulting be a bit more eager, only switched off when a peer or ancestor (but not child) constraint is insoluble. See Note [When to do type-class defaulting]. Small refactorings * Rename `askNoErrs` to `askErrsFound` and flip its polarity * The code for "check if ei_suppress is true of all items" code is moved to `mkErrorItems` rather than in the large `reportWanteds`. * Code for `has_gadt_match` moves to `mkGivenErrorReporter`, rather than polluting the large `reportWanteds`. * Many tests with `-fdefer-type-errors` get more warnings, especially about ambiguous (Num a) constraints. This is by-design: see Note [Always warn with -fdefer-type-errors]. Previously GHC was not honouring this Note but now it is, hence the extra errors. - - - - - f217fc31 by Cheng Shao at 2026-10-11T14:39:33-04:00 compiler: ensure cross ghc --info output target unit ids Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in --info output do not match the target unit ids reported by ghc-pkg, breaking cross ghc release builds with hash-unit-ids when being used with cabal 3.18. This patch fixes it by making --info output target unit ids. Fixes #27919. Co-authored-by: Codex <codex(a)openai.com> - - - - - 8f5937e7 by Simon Peyton Jones at 2026-10-12T00:09:05+01:00 Redesign the noinline magic Main idea: * When simplifying `noinline (f e1 e2)`, switch off inlining when simplifying `f` * Mechanism: see `simplOutId`, the `noinlineIdKey` case * If we see `noinline (f e1) e2`, the simplifier moves the `e2` inside; see the `splitContArgs` call. This is important so you can write `noinliine f e1 e2` and have it mean the same as `noinline (f e1 e2)`. * Now `f` sees all its arguments, henc: * Fixes #27724 * Fixes #23911 * Also fixes #27803 where we were not respecting `noinline` if the RHS was trivial See Note [noinlineId magic] for lots of specifics. It's surprisingly tricky! For some reason a couple of perf tests allocate 1.2% less at compile time,n namely T29872 and T8095. Geom mean decease of 0.1% Metric Decrease: T9872d - - - - - d863df6b by Simon Peyton Jones at 2026-10-12T00:09:17+01:00 Wibbles after LLM review - - - - - 126 changed files: - .gitlab/hello.hs - + changelog.d/26761 - + changelog.d/T23785 - + changelog.d/T27545 - + changelog.d/T27724 - + changelog.d/T27731 - + changelog.d/T27916 - + changelog.d/fix-cross-ghc-info-unit-id - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Builtin/WiredIn/Types/Box.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/Language/Haskell/Syntax/Lit.hs - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - libraries/containers - libraries/ghc-internal/src/GHC/Internal/Magic.hs - testsuite/tests/corelint/LintEtaExpand.hs - + testsuite/tests/dmdanal/should_compile/T23911.hs - + testsuite/tests/dmdanal/should_compile/T23911.stderr - testsuite/tests/dmdanal/should_compile/all.T - testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020b.stderr - testsuite/tests/ghci/prog021/prog021a.stderr - testsuite/tests/ghci/prog021/prog021b.stderr - testsuite/tests/ghci/prog022/ghci.prog022a.stderr - testsuite/tests/ghci/prog022/ghci.prog022b.stderr - testsuite/tests/ghci/prog022/ghci.prog022c.stderr - testsuite/tests/ghci/prog022/ghci.prog022d.stderr - testsuite/tests/ghci/prog022/ghci.prog022e.stderr - testsuite/tests/ghci/prog022/ghci.prog022f.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/module/mod130.stderr - + testsuite/tests/numeric/should_run/T27545.hs - + testsuite/tests/numeric/should_run/T27545.stdout - testsuite/tests/numeric/should_run/all.T - testsuite/tests/overloadedstrings/should_fail/T25926.stderr - testsuite/tests/overloadedstrings/should_fail/T27124.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr - + testsuite/tests/plugins/T26761.hs - + testsuite/tests/plugins/T26761.stderr - + testsuite/tests/plugins/T26761Plugin.hs - + testsuite/tests/plugins/T26761a.hs - testsuite/tests/plugins/all.T - testsuite/tests/printer/T17697.stderr - testsuite/tests/rename/should_fail/T15607.stderr - testsuite/tests/rename/should_fail/T19843b.stderr - testsuite/tests/safeHaskell/ghci/p4.stderr - testsuite/tests/safeHaskell/ghci/p6.stderr - testsuite/tests/simplCore/should_compile/T18995.stderr - testsuite/tests/simplCore/should_compile/T22611.hs - testsuite/tests/simplCore/should_compile/T22611.stderr - + testsuite/tests/simplCore/should_compile/T22611a.hs - + testsuite/tests/simplCore/should_compile/T27724a.hs - + testsuite/tests/simplCore/should_compile/T27724a.stderr - + testsuite/tests/simplCore/should_compile/T27803.hs - + testsuite/tests/simplCore/should_compile/T27803.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/T11254.stderr - testsuite/tests/typecheck/should_compile/T15370.stderr - + testsuite/tests/typecheck/should_compile/T27916.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/ClassOperator.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T17940.stderr - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T18851f.hs - + testsuite/tests/typecheck/should_fail/T18851f.stderr - testsuite/tests/typecheck/should_fail/T22940.stderr - testsuite/tests/typecheck/should_fail/T26823.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/T5691.stderr - testsuite/tests/typecheck/should_fail/T7437.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/mc24.stderr - testsuite/tests/typecheck/should_fail/tcfail019.stderr - testsuite/tests/typecheck/should_fail/tcfail189.stderr - utils/genprimopcode/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0846506b7cbcba25443eaec6814cd8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0846506b7cbcba25443eaec6814cd8… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/rafl/hpc-viewpatterns
by Florian Ragwitz (＠rafl) 11 Oct '26

11 Oct '26

Florian Ragwitz pushed new branch wip/rafl/hpc-viewpatterns at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rafl/hpc-viewpatterns You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] compiler: ensure cross ghc --info output target unit ids
by Marge Bot (＠marge-bot) 11 Oct '26

11 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f217fc31 by Cheng Shao at 2026-10-11T14:39:33-04:00 compiler: ensure cross ghc --info output target unit ids Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in --info output do not match the target unit ids reported by ghc-pkg, breaking cross ghc release builds with hash-unit-ids when being used with cabal 3.18. This patch fixes it by making --info output target unit ids. Fixes #27919. Co-authored-by: Codex <codex(a)openai.com> - - - - - 10 changed files: - .gitlab/hello.hs - + changelog.d/fix-cross-ghc-info-unit-id - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== .gitlab/hello.hs ===================================== @@ -27,7 +27,11 @@ fakeSettings = sTargetPlatform = genericPlatform, sPlatformMisc = PlatformMisc {}, - sUnitSettings = UnitSettings { unitSettings_baseUnitId = stringToUnitId "base" } + sUnitSettings = UnitSettings + { unitSettings_baseUnitId = stringToUnitId "base" + , unitSettings_ghcUnitId = stringToUnitId "ghc" + , unitSettings_ghcInternalUnitId = stringToUnitId "ghc-internal" + } } fakeDynFlags :: DynFlags ===================================== changelog.d/fix-cross-ghc-info-unit-id ===================================== @@ -0,0 +1,4 @@ +section: compiler +synopsis: Fix a bug where unit ids in cross ghc --info output doesn't match ghc-pkg output, breaking cross ghc releases with cabal 3.18. +mrs: !16790 +issues: #27919 ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -546,7 +546,8 @@ opt_i dflags= toolSettings_opt_i $ toolSettings dflags setBaseUnitId :: String -> DynP () -setBaseUnitId s = upd $ \d -> d { unitSettings = UnitSettings (stringToUnitId s) } +setBaseUnitId s = upd $ \d -> d + { unitSettings = (unitSettings d) { unitSettings_baseUnitId = stringToUnitId s } } ----------------------------------------------------------------------------- @@ -3663,8 +3664,6 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), - ("Project Unit Id", cProjectUnitId), - ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Settings.hs ===================================== @@ -94,7 +94,11 @@ data Settings = Settings , sRawTarget :: Target } -data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId } +data UnitSettings = UnitSettings + { unitSettings_baseUnitId :: !UnitId + , unitSettings_ghcUnitId :: !UnitId + , unitSettings_ghcInternalUnitId :: !UnitId + } -- | Settings for other executables GHC calls. -- ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -142,6 +142,8 @@ initSettings top_dir = do ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" + ghcUnitId <- getSetting_raw "Project Unit Id" + ghcInternalUnitId <- getSetting_raw "ghc-internal Unit Id" -- LibDir is optional. If not set, derive it from topDir. This allows -- bindists to work without explicitly setting LibDir, but gives us the @@ -174,6 +176,8 @@ initSettings top_dir = do , sUnitSettings = UnitSettings { unitSettings_baseUnitId = stringToUnitId baseUnitId + , unitSettings_ghcUnitId = stringToUnitId ghcUnitId + , unitSettings_ghcInternalUnitId = stringToUnitId ghcInternalUnitId } , sToolSettings = ToolSettings ===================================== distrib/configure.ac.in ===================================== @@ -406,6 +406,12 @@ fi AC_SUBST(BaseUnitId) +dnl The units supplied with the target libraries, as reported by ghc --info. +GhcUnitId=@GhcUnitId@ +GhcInternalUnitId=@GhcInternalUnitId@ +AC_SUBST(GhcUnitId) +AC_SUBST(GhcInternalUnitId) + # We get caught by # http://savannah.gnu.org/bugs/index.php?1516 # $(eval ...) inside conditionals causes errors ===================================== hadrian/bindist/Makefile ===================================== @@ -90,6 +90,8 @@ lib/settings : config.mk @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ + @echo ',("Project Unit Id", "$(GhcUnitId)")' >> $@ + @echo ',("ghc-internal Unit Id", "$(GhcInternalUnitId)")' >> $@ @echo "]" >> $@ lib/targets/default.target : config.mk default.target ===================================== hadrian/bindist/config.mk.in ===================================== @@ -134,6 +134,8 @@ CrossCompilePrefix = @CrossCompilePrefix@ GhcUnregisterised = @Unregisterised@ EnableDistroToolchain = @EnableDistroToolchain@ BaseUnitId = @BaseUnitId@ +GhcUnitId = @GhcUnitId@ +GhcInternalUnitId = @GhcInternalUnitId@ # The THREADED_RTS requires `BaseReg` to be in a register and the # `GhcUnregisterised` mode doesn't allow that. ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -232,7 +232,7 @@ buildBinDistDir root conf@BindistConfig{..} = do let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" bindistContext = vanillaContext library_stage compiler bindistSettingsContent <- interpretInContext bindistContext $ - generateSettings bindistSettings False "package.conf.d" + generateSettings library_stage bindistSettings False "package.conf.d" writeFileAtomic bindistSettings bindistSettingsContent copyDirectory rtsIncludeDir bindistFilesDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -7,6 +7,7 @@ module Rules.Generate ( import Development.Shake.FilePath import qualified Data.Set as Set import Base +import BindistConfig import qualified Context import Expression import Hadrian.Oracles.TextFile (lookupStageBuildConfig) @@ -275,7 +276,7 @@ generateRules = do then root -/- stageString stage' -/- "lib" else prefix relPkgDb = makeRelativeNoSysLink libTopDir pkgDb - go (generateSettings out True relPkgDb) out + go (generateSettings libStage out True relPkgDb) out (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out where @@ -451,7 +452,9 @@ bindistRules = do , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . targetStage) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors - , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base + , interpolateVar "BaseUnitId" $ bindistUnitId base + , interpolateVar "GhcUnitId" $ bindistUnitId compiler + , interpolateVar "GhcInternalUnitId" $ bindistUnitId ghcInternal , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2 , interpolateVar "TargetPlatformFull" (setting TargetPlatformFull) , interpolateVar "BuildPlatformFull" (setting BuildPlatformFull) @@ -460,6 +463,9 @@ bindistRules = do where interp = interpretInContext (semiEmptyTarget Stage2) getTarget = interp . queryTarget Stage2 + bindistUnitId pkg = do + stage <- library_stage <$> implicitBindistConfig + pkgUnitId stage pkg -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that -- the resulting 'String' is a valid C preprocessor identifier. @@ -485,18 +491,18 @@ ghcWrapper stage = do -- "package.conf.d"). Callers supply the correct relative path. For bindists -- the layout is known statically; for in-tree builds callers compute it. For -- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. -generateSettings :: FilePath -> Bool -> FilePath -> Expr String -generateSettings settingsFile includeLibDir rel_pkg_db = do +-- +-- @libraryStage@: the stage containing the target package database. +generateSettings :: Stage -> FilePath -> Bool -> FilePath -> Expr String +generateSettings libraryStage settingsFile includeLibDir rel_pkg_db = do ctx <- getContext stage <- getStage - -- The unit-id of the base package which is always linked against (#25382) - base_unit_id <- expr $ do - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> pkgUnitId Stage1 base - Stage2 -> pkgUnitId Stage1 base - Stage3 -> pkgUnitId Stage2 base + -- These are the units supplied in the target package database, which can + -- differ from the host units linked into a cross compiler. + base_unit_id <- expr $ pkgUnitId libraryStage base + ghc_unit_id <- expr $ pkgUnitId libraryStage compiler + ghc_internal_unit_id <- expr $ pkgUnitId libraryStage ghcInternal -- For cross compilers, LibDir points to the succeeding stage's lib dir -- (which contains the target architecture's libraries). For non-cross, @@ -519,6 +525,8 @@ generateSettings settingsFile includeLibDir rel_pkg_db = do , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) + , ("Project Unit Id", pure ghc_unit_id) + , ("ghc-internal Unit Id", pure ghc_internal_unit_id) ] ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir]) let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" @@ -555,7 +563,6 @@ generateConfigHs = do -- unit-id in both situations. cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage - cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -565,7 +572,6 @@ generateConfigHs = do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" - , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -589,9 +595,6 @@ generateConfigHs = do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId - , "" - , "cGhcInternalUnitId :: String" - , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] where stageString (Stage0 InTreeLibs) = "1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f217fc315b7fc67a7a96bafc08f3039… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f217fc315b7fc67a7a96bafc08f3039… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] Simplify the error-suppression mechanism in GHC.Tc.Errors
by Marge Bot (＠marge-bot) 11 Oct '26

11 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41e80f41 by Simon Peyton Jones at 2026-10-11T14:38:51-04:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In `GHC.Tc.Errors.reportWanteds` we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. Main changes * Instead of /predicting/ when an error will be reported, we set `cec_error_reported` when an error is /actually/ reported. (I renamed it from `cec_suppress` to reflect this change.) Now errors are suppressed only when a preceding error has actually been reported. Simpler and more robust. See `Note [cec_error_reported: suppressing less-serious errors]` The big changes are in `reportWanteds` which looks very different. * New `Note [ei_suppress: suppressing confusing errors]` describes the (quite separate) `ei_suppress` mechanism for suppressing confusing errors, mainly arising from non-empty rewriter sets * In `tryTypeClassDefaulting`, instead of switching off type-class defaulting if there is an insoluble /anywhere/, we just switch it off locally when we find an insoluble sub-tree. See Note [When to do type-class defaulting] and (W5) in Note [ApproximateWC] * Greatly simplify `insolubleWantedCt`. * I made type-class-defaulting be a bit more eager, only switched off when a peer or ancestor (but not child) constraint is insoluble. See Note [When to do type-class defaulting]. Small refactorings * Rename `askNoErrs` to `askErrsFound` and flip its polarity * The code for "check if ei_suppress is true of all items" code is moved to `mkErrorItems` rather than in the large `reportWanteds`. * Code for `has_gadt_match` moves to `mkGivenErrorReporter`, rather than polluting the large `reportWanteds`. * Many tests with `-fdefer-type-errors` get more warnings, especially about ambiguous (Num a) constraints. This is by-design: see Note [Always warn with -fdefer-type-errors]. Previously GHC was not honouring this Note but now it is, hence the extra errors. - - - - - 53 changed files: - + changelog.d/T27731 - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020b.stderr - testsuite/tests/ghci/prog021/prog021a.stderr - testsuite/tests/ghci/prog021/prog021b.stderr - testsuite/tests/ghci/prog022/ghci.prog022a.stderr - testsuite/tests/ghci/prog022/ghci.prog022b.stderr - testsuite/tests/ghci/prog022/ghci.prog022c.stderr - testsuite/tests/ghci/prog022/ghci.prog022d.stderr - testsuite/tests/ghci/prog022/ghci.prog022e.stderr - testsuite/tests/ghci/prog022/ghci.prog022f.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/module/mod130.stderr - testsuite/tests/overloadedstrings/should_fail/T25926.stderr - testsuite/tests/overloadedstrings/should_fail/T27124.stderr - testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr - testsuite/tests/printer/T17697.stderr - testsuite/tests/rename/should_fail/T15607.stderr - testsuite/tests/rename/should_fail/T19843b.stderr - testsuite/tests/safeHaskell/ghci/p4.stderr - testsuite/tests/safeHaskell/ghci/p6.stderr - testsuite/tests/typecheck/should_compile/T11254.stderr - testsuite/tests/typecheck/should_compile/T15370.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/ClassOperator.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T18851f.hs - + testsuite/tests/typecheck/should_fail/T18851f.stderr - testsuite/tests/typecheck/should_fail/T22940.stderr - testsuite/tests/typecheck/should_fail/T26823.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/T5691.stderr - testsuite/tests/typecheck/should_fail/T7437.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/mc24.stderr - testsuite/tests/typecheck/should_fail/tcfail019.stderr - testsuite/tests/typecheck/should_fail/tcfail189.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41e80f412079409dd615df442f430bf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41e80f412079409dd615df442f430bf… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T26543b] 3 commits: Line up simpleUnifyCheck and check_ty_eq_rhs
by Simon Peyton Jones (＠simonpj) 11 Oct '26

11 Oct '26

Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC Commits: 0d9e8c71 by Simon Peyton Jones at 2026-10-11T16:52:14+01:00 Line up simpleUnifyCheck and check_ty_eq_rhs Even after #26543 was allegedly fixed, the original repo case in the Description continued to fail. The reason was that the QuickLook unifier, `qlUnify`, used `simpleUnifyCheck` for checking unification invariants; and `simpleUnifyCheck` conservatively rejected any RHS with a coercion hole in it. The upshot was that QuickLook was not as clever as it should be, wrongly failing to do an impredicative instantiation. Interestingly `check_ty_eq_rhs`, which does the same job during constraint solving, was more liberal: it just looked at the free vars of the coercion, and allowed coercion holes. This MR lines them up, adding some careful notes. See Note [simpleUnifyCheck] Note [Occurs check and coercions] Note [Unification preconditions] esp (COERCIONS) Things are better than before, but I am still uncomfortable about the possibilty that a hole might be filled with a coercion that mentions the LHS type variable; for now I have left this discomfort documented in Note [Occurs check and coercions]. Main changes * `qlUnify` now only unifies /instantiation variables/ not regular unification variables. This makes QuickLook more predictable. See (UQL6) in Note [QuickLook unification]. * `qlUnify` no longer needs to call `simpleUnifyCheck`, so we can get rid of `UC_QuickLook` and its code in `simpleUnifyCheck`. * I found I could get rid of `mkOccFolders` in favour of `anyFreeVarsOfType`. Hooray. * Improve documentation of CycleBreakerTv, and rename it to GivenCycleBreakerTv because they are only uesd for Givens! * I accepted a 9% worsening in compile time allocation on T5030 because the newly-consistent story triggered #27934. Other changes * I refactored `atvFolder` so that it pairs the "interesting-var" function with the in-scope set, to avoid building a closure with a free variable. Now we get nice tight loops for `anyFreeVarsOfType` and friends. See Note [Any-free-var folder]. Metric Increase: T5030 - - - - - 59818c74 by Simon Peyton Jones at 2026-10-11T16:52:40+01:00 Fix order-dependence in QuickLook Ticket #27917 pointed out that QuickLook was order-dependent -- very bad! The solution is in `qlUnify`: spot when we are unifying a type with a definite monotype, and then monomorphise any free instantiation variables of that type. See (UQL8) and (UQL9) in Note [QuickLook unification]. - - - - - 9bdde170 by Simon Peyton Jones at 2026-10-11T16:52:40+01:00 Add some comments about RuntimeUnk This commit just adds comments explaining why we don't need to worry about RuntimeUnkTv in the constraint solver. It also tightens up docmentation of earlier (overlapping) commits in this MR. - - - - - 24 changed files: - + changelog.d/T26543 - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Var/FV.hs - testsuite/tests/default/default-fail05.stderr - testsuite/tests/ghci.debugger/scripts/T14628.stderr - + testsuite/tests/impredicative/T27917.hs - testsuite/tests/impredicative/all.T - testsuite/tests/indexed-types/should_fail/T1897b.stderr - testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs - + testsuite/tests/typecheck/should_compile/T26543_orig.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T22707.stderr - + testsuite/tests/typecheck/should_fail/T26543a.hs - + testsuite/tests/typecheck/should_fail/T26543a.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== changelog.d/T26543 ===================================== @@ -0,0 +1,7 @@ +section: compiler +synopsis: Fix a bug in ImpredicativeTypes +description: + The QuickLook algorithm (which implements `ImpredicativeTypes`) was defeated if there + was a kind coercion in the types being unified. That bug is now fixed. +mrs: !16566 +issues: #26543 ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -223,11 +223,11 @@ addCoreBndrsFV bndrs fv = foldr addCoreBndrFV fv bndrs unitFV :: Var -> SelectiveDFV -- Deals with an occurrence -- Shallow: does not look at the kind -unitFV v = MkFV (\bvs -> EndoOS (do_it bvs)) +unitFV v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs, is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude the bound vars | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -278,14 +278,15 @@ deepUnitFV :: (Type -> TyCoFV) -> TyCoVar -> TyCoFV -- Deal with a single TyCoVar -- Takes a function to find free vars of the kind -- See Note [Computing deep free variables] -deepUnitFV fvs_of_kind v - = MkFV (\bvs -> EndoOS (do_it bvs)) +{-# INLINE deepUnitFV #-} -- INLINE to specialise on fvs_of_kind +deepUnitFV fvs_of_kind + = \v -> MkFV (\bvs -> EndoOS (do_it bvs v)) where - do_it :: BoundVars -> TyCoVarSet -> TyCoVarSet - do_it bvs acc | v `elemVarSet` bvs = acc - | v `elemVarSet` acc = acc - | otherwise = runFVAcc (fvs_of_kind (varType v)) acc - `extendVarSet` v + do_it :: BoundVars -> TyCoVar -> TyCoVarSet -> TyCoVarSet + do_it bvs v acc | v `elemVarSet` bvs = acc + | v `elemVarSet` acc = acc + | otherwise = runFVAcc (fvs_of_kind (varType v)) acc + `extendVarSet` v -- Left-to-right: add the kind variables to the -- accumulator before v itself @@ -443,11 +444,11 @@ selectiveTcvFolder , tcf_hole = do_hole , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv v = MkFV (\bvs -> EndoOS (do_it bvs)) + do_tcv v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs,is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude bound variables | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v @@ -847,43 +848,76 @@ invisibleVarsOfTypes = foldr (unionVarSet . invisibleVarsOfType) emptyVarSet * * ********************************************************************* -} -{-# INLINE afvFolder #-} -- so that specialization to (const True) works -afvFolder :: (TyCoVar -> Bool) -> TyCoFolder (FV TyCoVarSet DM.Any) +{- Note [Any-free-var folder] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The "any-free-var" folders take a `check_fv` predicate (TyCoVar -> Bool) and +check if any /deep/ free variable of the type/coercion satisfies it. So + + anyFreeVarsOfType p ty = anyVarSet p (tyCoVarsOfType ty) + +Our main folders look like: + + afv_type :: Type -> FV (BoundVars, TyVar -> Bool) Any + +where we cleverly pair the predicate with the forall-bound variables of the type +in the "env" field of (FV env Any). This way we can build the /folder/ once and +for all (independent of the `check_fv` predicate), and the loop passes down +the pair. + +The same idiom is used in `exprFreeVarsDSet` and friends. + +However we are careful to INLINE `atvFolder` and `runAny` so that we get those +nice tight loops. +-} + +{-# INLINE afvFolder #-} -- See Note [Any-free-var folder] +afvFolder :: TyCoFolder (FV (BoundVars, TyCoVar -> Bool) DM.Any) -- 'afvFolder' is short for "any-free-var folder", good for checking --- if any free var of a type satisfies a predicate `check_fv` -afvFolder check_fv = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] - , tcf_tyvar = do_tcv, tcf_covar = do_tcv - , tcf_hole = do_hole - , tcf_tycobinder = addBndrFV } +-- if any /deep/ free var of a type satisfies a predicate `check_fv` +-- The "env" of the (FV env Any) is a pair (bvs,pred) of +-- the bound variables (which are definitely not free), and +-- an "interesting var" predicate which the client supplies +afvFolder = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] + , tcf_tyvar = do_tcv + , tcf_covar = do_tcv + , tcf_hole = do_hole + , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv tv = MkFV $ \ bvs -> - Any (not (tv `elemVarSet` bvs) && check_fv tv) - do_hole _ = mempty -- I'm unsure; probably never happens + -- Check the variable itself with check_fv, + -- and check its kind (this is a deep folder) + do_tcv tcv = MkFV $ \ (bvs,check_fv) -> + Any (not (tcv `elemVarSet` bvs) && + (check_fv tcv || runAny check_fv (afv_type (varType tcv)))) + do_hole hole = do_tcv (coHoleCoVar hole) + +afv_type :: Type -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_types :: [Type] -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_co :: Coercion -> FV (BoundVars, TyVar -> Bool) DM.Any +(afv_type, afv_types, afv_co, _) = foldTyCo afvFolder + +runAny :: (TyVar -> Bool) -> FV (BoundVars, TyCoVar -> Bool) DM.Any -> Bool +{-# INLINE runAny #-} +runAny check_fv fvs = DM.getAny (runFV fvs (emptyVarSet, check_fv)) anyFreeVarsOfType :: (TyCoVar -> Bool) -> Type -> Bool -anyFreeVarsOfType check_fv ty = DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder check_fv) +{-# INLINE anyFreeVarsOfType #-} +anyFreeVarsOfType check_fv ty = runAny check_fv (afv_type ty) anyFreeVarsOfTypes :: (TyCoVar -> Bool) -> [Type] -> Bool -anyFreeVarsOfTypes check_fv tys = DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder check_fv) +{-# INLINE anyFreeVarsOfTypes #-} +anyFreeVarsOfTypes check_fv tys = runAny check_fv (afv_types tys) anyFreeVarsOfCo :: (TyCoVar -> Bool) -> Coercion -> Bool -anyFreeVarsOfCo check_fv co = DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfCo check_fv co = runAny check_fv (afv_co co) noFreeVarsOfType :: Type -> Bool -noFreeVarsOfType ty = not $ DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfType ty = not $ runAny (const True) (afv_type ty) noFreeVarsOfTypes :: [Type] -> Bool -noFreeVarsOfTypes tys = not $ DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfTypes tys = not $ runAny (const True) (afv_types tys) noFreeVarsOfCo :: Coercion -> Bool -noFreeVarsOfCo co = not $ DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder (const True)) - +noFreeVarsOfCo co = not $ runAny (const True) (afv_co co) {- ************************************************************************ ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -628,18 +628,16 @@ be sigmas and not taus. {- Note [RuntimeUnkTv] ~~~~~~~~~~~~~~~~~~~~~~ -In the GHCi debugger we use unification variables whose MetaInfo is -RuntimeUnkTv. The special property of a RuntimeUnkTv is that it can -unify with a polytype (see GHC.Tc.Utils.Unify.checkTypeEq). -If we don't do this `:print <term>` will fail if the type of <term> -has nested `forall`s or `=>`s. - -This is because the GHCi debugger's internals will attempt to unify a -metavariable with the type of <term> and then display the result, but -if the type has nested `forall`s or `=>`s, then unification will fail -unless we do something special. As a result, `:print` will bail out -and the unhelpful result will be `<term> = (_t1::t1)` (where `t1` is a -metavariable). +In the GHCi debugger we use unification variables whose MetaInfo is RuntimeUnkTv. +The special property of a RuntimeUnkTv is that it can unify with a polytype (see +GHC.Tc.Utils.Unify.simpleUnifyCheck). If we don't do this `:print <term>` will fail if +the type of <term> has nested `forall`s or `=>`s. + +This is because the GHCi debugger's internals will attempt to unify a metavariable +with the type of <term> and then display the result, but if the type has nested +`forall`s or `=>`s, then unification will fail unless we do something special. As +a result, `:print` will bail out and the unhelpful result will be `<term> = +(_t1::t1)` (where `t1` is a metavariable). Beware: <term> can have nested `forall`s even if its definition doesn't use RankNTypes! Here is an example from #14828: @@ -654,13 +652,18 @@ We could envision deeply instantiating this type to get the type `forall f a b. Functor f => (a -> b) -> f a -> f b`, but this trick wouldn't work for higher-rank types. -Instead, we adopt a simpler fix: allow RuntimeUnkTv to unify with a -polytype (specifically, see ghci_tv in GHC.Tc.Utils.Unify.preCheck). -This allows metavariables to unify with types that have -nested (or higher-rank) `forall`s/`=>`s, which makes `:print fmap` -display as -`fmap = (_t1::forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b)`, +Instead, we adopt a simpler fix: allow RuntimeUnkTv to unify with a polytype +(specifically, see ghci_tv in GHC.Tc.Utils.Unify.preCheck). This allows +metavariables to unify with types that have nested (or higher-rank) +`forall`s/`=>`s, which makes `:print fmap` display as + `fmap = (_t1::forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b)`, as expected. + +(RUT1) The debugger uses the "on-the-fly" unifier, namely + GHC.Tc.Utils.Unify.unifyType + and /ignores/ any constraints it generates: see `addConstraint`. It never + calls the constraint solver, so the constraint solver does not need to + understand about RuntimeUnkTvs. -} ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.ConLike ( ConLike(..) ) import GHC.Core.DataCon ( dataConConcreteTyVars, isNewDataCon, dataConOrigArgTys ) import GHC.Core.TyCon import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.FVs import GHC.Core.TyCo.Ppr import GHC.Core.TyCo.Subst ( substTyWithInScope ) import GHC.Core.Type @@ -631,11 +632,13 @@ tcInstFun :: QLFlag -- plus the modification in Fig 5, of the QL paper: -- "A quick look at impredicativity" (ICFP'20). tcInstFun do_ql inst_final rn_head@(_, fun_lspan) tc_fun fun_sigma rn_args - = do { traceTc "tcInstFun" (vcat [ text "tc_fun" <+> ppr tc_fun + = do { lvl <- getTcLevel + ; traceTc "tcInstFun" (vcat [ text "tc_fun" <+> ppr tc_fun , text "rn_fun" <+> ppr rn_head , text "fun_sigma" <+> ppr fun_sigma , text "args:" <+> ppr rn_args - , text "do_ql" <+> ppr do_ql]) + , text "do_ql" <+> ppr do_ql + , text "lvl:" <+> ppr lvl ]) ; fun_origin <- mk_origin rn_head ; res@(_, fun_ty) <- go fun_origin 1 [] fun_sigma rn_args ; traceTc "tcInstFun:ret" (ppr fun_ty) @@ -1377,13 +1380,15 @@ tc_inst_forall_arg conc_tvs (tvb, inner_ty) hs_ty -- is not fully zonked, because ty_arg is fully zonked. -- See Note [Type application substitution]. + ; lvl <- getTcLevel ; traceTc "tc_inst_forall_arg (VTA/VDQ)" ( vcat [ text "fun_ty" <+> ppr fun_ty , text "tv" <+> ppr tv <+> dcolon <+> debugPprType kind , text "ty_arg" <+> debugPprType ty_arg <+> dcolon <+> debugPprType (typeKind ty_arg) , text "inner_ty" <+> debugPprType inner_ty - , text "insted_ty" <+> debugPprType insted_ty ]) + , text "insted_ty" <+> debugPprType insted_ty + , text "lvl:" <+> ppr lvl ]) ; return (ty_arg, insted_ty) } {- Note [Visible type application and abstraction] @@ -1934,11 +1939,13 @@ quickLookArg1 pos app_lspan rn_head larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_ -- capture and save it in the `EValArgQL`. See (QLA6) in -- Note [Quick Look at value arguments] + ; lvl <- getTcLevel ; traceTc "quickLookArg {" $ vcat [ text "arg:" <+> ppr arg , text "orig_arg_rho:" <+> ppr orig_arg_rho , text "head:" <+> ppr rn_fun_arg <+> dcolon <+> ppr mb_fun_ty - , text "args:" <+> ppr rn_args ] + , text "args:" <+> ppr rn_args + , text "level:" <+> ppr lvl ] ; case mb_fun_ty of { Nothing -> skipQuickLook app_lspan larg sc_arg_ty ; -- fun is too complicated @@ -2048,6 +2055,8 @@ qlMonoHsWrapper (WpTyApp ty) = qlMonoTcType ty qlMonoHsWrapper _ = return () qlMonoTcType :: TcType -> ZonkM () +-- Monomorphise any free instantiation variables of `ty` +-- This functions zonks as it goes -- See Note [Monomorphise instantiation variables] qlMonoTcType ty = do { traceZonk "monomorphiseQLInstVars {" (ppr ty) @@ -2149,8 +2158,7 @@ foldQLInstVars check_tv ty qlUnify :: TcType -> TcType -> TcM () -- Unify ty1 with ty2: --- * It can unify both instantiation variables (possibly with polytypes), --- and ordinary unification variables (but only with monotypes) +-- * It unifies /only/ instantiation variables (see (UQL6)), hopefully with polytypes -- * It does not return a coercion (unlike unifyType); it is called -- for the sole purpose of unifying instantiation variables, although it -- may also (opportunistically) unify regular unification variables. @@ -2158,18 +2166,23 @@ qlUnify :: TcType -> TcType -> TcM () -- * It may return without having made the argument types equal, of course; -- it just makes best efforts. qlUnify ty1 ty2 - = do { traceTc "qlUnify" (ppr ty1 $$ ppr ty2) + = do { lvl <- getTcLevel + ; traceTc "qlUnify" (ppr lvl $$ ppr ty1 $$ ppr ty2) ; go ty1 ty2 } where go :: TcType -> TcType -> TcM () + go t1 t2 = do { traceTc "qlUinfy:go" (ppr t1 <+> char '~' <+> ppr t2) + ; go' t1 t2 } + -- Decompose (arg1 -> res1) ~ (arg2 -> res2) -- and (c1 => res1) ~ (c2 => res2) -- But for the latter we only learn instantiation info from res1~res2 - go (FunTy { ft_af = af1, ft_arg = arg1, ft_res = res1 }) + go' (FunTy { ft_af = af1, ft_arg = arg1, ft_res = res1 }) (FunTy { ft_af = af2, ft_arg = arg2, ft_res = res2 }) | af1 == af2 -- Match the arrow TyCon - = do { when (isVisibleFunArg af1) (go arg1 arg2) + = do { traceTc "go_fun" (ppr arg1 $$ ppr arg2) + ; when (isVisibleFunArg af1) (go arg1 arg2) -- NB: we do not unify the multiplicities; that would be too strong. -- We might only require mult1 ⩽ mult2, as in Note [Multiplicity in deep subsumption]. @@ -2178,30 +2191,29 @@ qlUnify ty1 ty2 ; go res1 res2 } -- Make sure to not unify "kappa := (a %1 -> b)". See (UQL5). - go (FunTy { ft_mult = OneTy }) _ = return () - go _ (FunTy { ft_mult = OneTy }) = return () - -- NB: we do want to be able to unify "kappa := a => b", as that's - -- the main point of QuickLook (allowing meta-variables to be unified - -- with qualified types). + -- NB: we /do/ want to be able to unify "kappa := a => b", as that's + -- the main point of QuickLook (allowing meta-variables to be unified + -- with qualified types). + go' (FunTy { ft_mult = OneTy }) _ = return () + go' _ (FunTy { ft_mult = OneTy }) = return () - go (TyVarTy tv) ty2 - | isMetaTyVar tv = go_kappa tv ty2 - go ty1 (TyVarTy tv) - | isMetaTyVar tv = go_kappa tv ty1 + -- Type variables; see (UQL6) in Note [QuickLook unification] + go' (TyVarTy tv) ty2 | isMetaTyVar tv = go_meta tv ty2 + go' ty1 (TyVarTy tv) | isMetaTyVar tv = go_meta tv ty1 - go (CastTy ty1 _) ty2 = go ty1 ty2 - go ty1 (CastTy ty2 _) = go ty1 ty2 + go' (CastTy ty1 _) ty2 = go ty1 ty2 + go' ty1 (CastTy ty2 _) = go ty1 ty2 - go (TyConApp tc1 []) (TyConApp tc2 []) + go' (TyConApp tc1 []) (TyConApp tc2 []) | tc1 == tc2 -- See GHC.Tc.Utils.Unify = return () -- Note [Expanding synonyms during unification] -- Now, and only now, expand synonyms - go rho1 rho2 + go' rho1 rho2 | Just rho1 <- coreView rho1 = go rho1 rho2 | Just rho2 <- coreView rho2 = go rho1 rho2 - go (TyConApp tc1 tys1) (TyConApp tc2 tys2) + go' (TyConApp tc1 tys1) (TyConApp tc2 tys2) | tc1 == tc2 , not (isTypeFamilyTyCon tc1) , tys1 `equalLength` tys2 @@ -2209,67 +2221,79 @@ qlUnify ty1 ty2 -- Don't allow unifying (a => b) with the AppTy 'arr[tau] a b'. -- To ensure this, use 'tcSplitAppTyNoView_maybe' which does not split (=>). - go (AppTy t1a t1b) ty2 + go' (AppTy t1a t1b) ty2 | Just (t2a, t2b) <- tcSplitAppTyNoView_maybe ty2 = do { go t1a t2a; go t1b t2b } - go ty1 (AppTy t2a t2b) + go' ty1 (AppTy t2a t2b) | Just (t1a, t1b) <- tcSplitAppTyNoView_maybe ty1 = do { go t1a t2a; go t1b t2b } - go _ _ = return () + -- Type families have a monomorphic result, so if we see (say) + -- Maybe kappa ~ F ty + -- we know that kappa must be a monotype + go' (TyConApp tc1 _) ty2 | isTypeFamilyTyCon tc1 = monomorphise ty2 + go' ty1 (TyConApp tc2 _) | isTypeFamilyTyCon tc2 = monomorphise ty1 + + go' _ _ = return () -- Don't look under foralls; see (UQL4) of Note [QuickLook unification] ---------------- - go_kappa kappa ty2 - = assertPpr (isMetaTyVar kappa) (ppr kappa) $ - do { info <- readMetaTyVar kappa - ; case info of + go_meta tv1 ty2 + = assertPpr (isMetaTyVar tv1) (ppr tv1) $ + do { info <- readMetaTyVar tv1 + ; case info of -- See (UQL9) Indirect ty1 -> go ty1 ty2 Flexi -> do { ty2 <- liftZonkM $ zonkTcType ty2 - ; go_flexi kappa ty2 } } + ; go_flexi tv1 ty2 } } ---------------- - -- Swap (kappa1[conc] ~ kappa2[tau]) - -- otherwise we'll fail to unify and emit a coercion. - -- Just an optimisation: emitting a coercion is fine - go_flexi kappa (TyVarTy tv2) - | lhsPriority tv2 > lhsPriority kappa - = go_flexi1 tv2 (TyVarTy kappa) - go_flexi kappa ty2 - = go_flexi1 kappa ty2 - - go_flexi1 kappa ty2 -- ty2 is zonked - = do { cur_lvl <- getTcLevel - -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles - -- Here we are in the TcM monad, which does not track enclosing - -- Given equalities; so for quick-look unification we conservatively - -- treat /any/ level outside this one as untouchable. Hence cur_lvl. - ; case simpleUnifyCheck UC_QuickLook cur_lvl kappa ty2 of - SUC_CanUnify -> - do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind - -- unifyKind: see (UQL2) in Note [QuickLook unification] - -- and (MIV2) in Note [Monomorphise instantiation variables] - ; let ty2' = mkCastTy ty2 co - ; traceTc "qlUnify:update" $ - ppr kappa <+> text ":=" <+> ppr ty2 - ; liftZonkM $ writeMetaTyVar kappa ty2' } - _ -> return () -- e.g. occurs-check or forall-bound variable - } + -- Both tv1 and ty2 are zonked; tv1 is a unfilled meta-tyvar + -- Zonking ty2 makes the occurs-check easier + go_flexi tv1 ty2 + | TyVarTy tv2 <- ty2 + , lhsPriority tv2 > lhsPriority tv1 + = go_flexi1 tv2 (TyVarTy tv1) + | otherwise + = go_flexi1 tv1 ty2 + + -- Both tv1 and ty2 are zonked; tv1 is a unfilled meta-tyvar + go_flexi1 tv1 ty2 + | isQLInstTyVar tv1 = go_kappa tv1 ty2 + | otherwise = monomorphise ty2 + + go_kappa kappa ty2 + | isConcreteTyVar kappa -- See (UQL7) in Note [QuickLook unification] + = return () + | anyFreeVarsOfType (== kappa) ty2 + = return () -- Occurs check. See (UQL10) in Note [QuickLook unification] + | otherwise + = do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind + -- unifyKind: see (UQL2) in Note [QuickLook unification] + -- and (MIV2) in Note [Monomorphise instantiation variables] + ; let ty2' = mkCastTy ty2 co + ; traceTc "qlUnify:update" $ + ppr kappa <+> text ":=" <+> ppr ty2 + ; liftZonkM $ writeMetaTyVar kappa ty2' + ; return () } where kappa_kind = tyVarKind kappa ty2_kind = typeKind ty2 + monomorphise :: TcType -> TcM () + monomorphise ty -- See (UQL8) + = do { _ <- liftZonkM $ qlMonoTcType ty; return () } + {- Note [QuickLook unification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In qlUnify, if we find (kappa ~ ty), we are going to update kappa := ty. That is the entire point of qlUnify! Wrinkles: -(UQL1) Before unifying an instantiation variable in `go_flexi`, we must check - the usual unification conditions, by calling `GHC.Tc.Utils.Unify.simpleUnifyCheck`. - For example that checks for +(UQL1) Before unifying an instantiation variable in `go_kappa`, we must check + the usual unification conditions. In particular: * An occurs-check - * Level mis-match * An attempt to unify a concrete type variable with a non-concrete type. + We don't need a level-check because the level of an instantiation variable + is infinity -- see (UQL3). (UQL2) What if kappa and ty have different kinds? We simply call the ordinary unifier and use the coercion to connect the two. @@ -2342,6 +2366,47 @@ That is the entire point of qlUnify! Wrinkles: constraint arrows =>, so that (UQL4) applies to them as well. See Note [Multiplicity in deep subsumption]. +(UQL6) What if `qlUnify` sees a regular (monotyped) unification variable, `alpha`, rather + than an instantiation variable `kappa`? Thus (alpha ~ ty). It's tempting to just + unify it, but the regular, on-the-fly unifier has lots of careful checks (levels, + concreteness etc). In regular unification it doesn't matter whether we unify on-the-fly + or later -- it's just an efficiency issue -- but we must maintain all the careful invariants. + + The simplest thing is to say that `qlUnify` unifies /only/ instantiation variables + (see calls to `isQLInstTyVar`). We could be more ambitious, perhaps, in future, but + beware of accidentally causing obscure /user-visible/ consequences (#26543), + e.g. via Note [Occurs check and coercions]. + + Remember, though, that the /only/ reason for QuickLoook is to unify instantiation variables + with polytypes; anything else is optional, and will be picked up with later "ordinary" + typechecking. So unifing only instantiation variables is enough. + +(UQL7) If `qlUnify` sees a concrete `kaapa`, thus + kappa[conc] ~ some-type + we just give up. It's tiresome to do all the checks for concreteness; and concrete + type variables are never unified with polytypes, so it's fine to leave it for the + regular unifier. + +(UQL8) If we see (Maybe kappa ~ alpha), where `kappa` is an instantiation variable + and `alpha` is a regular unification variable, we know that `kappa` must be a + monotype, so we can use `qlMonoTcType` to monomorphise it. This is important, + because rule APP-LIGHTNING in the QuickLook paper only fires when there are no free + instantiation variables. Unifying `kappa` with a monotype makes it more possible + for APP-LIGHTNING to fire. + + Same if we see (Maybe kappa ~ F tya) where F is a type function, becuase the result + of a type function is always a monotype. + +(UQL9) If we have (Maybe kappa ~ alpha) and we have /already/ unified alpha:=Maybe beta, + then it's more efficient to look through that unification and decompose, so that + we get (kappa ~ alpha). That way we don't have to monomorphise `kappa`. So we + "look through" all meta-tyvars, not just the instantiation vars. + +(UQL10) For the occurs check in `qlUnify` we simply use `anyFreeVarsOfType`. For + coercions that looks at the free vars of the coercion; but for coercion /holes/ + all it can do is look at the free vars of the hole's type. + See Note [Occurs check and coercions] in GHC.Tc.Utils.Unify + Sadly discarded design alternative ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is very tempting to use `unifyType` rather than `qlUnify`, killing off the ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -2584,15 +2584,15 @@ turn controls the behaviour of the workhorse: GHC.Tc.Utils.Unify.checkTyEqRhs. The details depend on whether we're working with a Given or a Wanted. -Given ------ +Note [Type equality cycles: Givens] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We emit a new Given, [G] F a ~ cbv, equating the type family application to our new cbv. This is actually done by `break_given` in `GHC.Tc.Solver.Monad.checkTypeEq`. -Note its orientation: The type family ends up on the left; see -Note [Orienting TyFamLHS/TyFamLHS]. No special treatment for -CycleBreakerTvs is necessary. This scenario is now easily soluble, by using +Note its orientation: The type family ends up on the left; +see Note [Orienting TyFamLHS/TyFamLHS]. No special treatment for +GivenCycleBreakerTvs is necessary. This scenario is now easily soluble, by using the first Given to rewrite the Wanted, which can now be solved. (The first Given actually also rewrites the second one, giving @@ -2613,10 +2613,11 @@ to Note that * `cbv` is a fresh cycle breaker variable. -* `cbv` is a meta-tyvar, but it is completely untouchable. +* `cbv` is a meta-tyvar, of flavour GivenCycleBreakerTv, but it is + completely untouchable. * We track the cycle-breaker variables in inert_cycle_breakers in InertSet -* We eventually fill in the cycle-breakers, with `cbv := F lhs`. - No one else fills in CycleBreakerTvs! +* We eventually fill in the cycle-breakers, with `cbv := F lhs`, + via `restoreTyVarCycles`. No one else fills in GivenCycleBreakerTvs! * The evidence for the new `F lhs ~ cbv` constraint is Refl, because we know this fill-in is ultimately going to happen. * In `inert_cycle_breakers`, we remember the (cbv, F lhs) pair; that is, we @@ -2626,8 +2627,8 @@ Note that * This fill-in is done when solving is complete, by restoreTyVarCycles in nestImplicTcS and runTcSWithEvBinds. -Wanted ------- +Note [Type equality cycles: Wanteds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ First, we do not cycle-break unless the LHS is a unifiable type variable See Note [Don't cycle-break Wanteds when not unifying] in GHC.Tc.Solver.Monad. @@ -2686,9 +2687,9 @@ to unify the cbvs: [W] AllEqF '[Bool] alpha Without the logic detailed in this Note, we're stuck here, as AllEqF cannot -reduce and alpha cannot unify. Let's instead apply our cycle-breaker approach, -just as described above. We thus invent cbv1 and cbv2 and unify -alpha := cbv1 -> cbv2, yielding (after zonking) +reduce and alpha cannot unify (occurs check). Let's instead apply our +cycle-breaker approach, just as described above. We thus invent cbv1 and cbv2 +and unify alpha := (cbv1 : cbv2), yielding (after zonking) [W] Head (cbv1 : cbv2) ~ cbv1 [W] Tail (cbv1 : cbv2) ~ cbv2 @@ -2726,8 +2727,8 @@ Note that we need to unify the cbvs here; if we did not, there would be no way to solve those constraints. That's why the cycle-breakers are ordinary TauTvs. -How all this is implemented ---------------------------- +Note [Type equality cycles: implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We implement all this via the `TEFA_Break` constructor of `TyEqFamApp`, itself stored in the `tef_fam_app` field of `TyEqFlags`, which controls the behaviour of `GHC.Tc.Utils.Unify.checkTyEqRhs`. The `TEFA_Break` @@ -2854,7 +2855,7 @@ More details: CycleBreakerOrigin. This works for both Givens and Wanteds, as we need the logic in the W case for e.g. typecheck/should_fail/T17139. Because this logic needs to work for Wanteds, too, we cannot simply look for a - CycleBreakerTv on the left: Wanteds don't use them. + GivenCycleBreakerTv on the left: Wanteds don't use them. ********************************************************************** ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -304,7 +304,7 @@ instance Outputable WorkList where ********************************************************************* -} type CycleBreakerVarStack = NE.NonEmpty (Bag (TcTyVar, TcType)) - -- ^ a stack of (CycleBreakerTv, original family applications) lists + -- ^ A stack of (GivenCycleBreakerTv, original family applications) lists -- first element in the stack corresponds to current implication; -- later elements correspond to outer implications -- used to undo the cycle-breaking needed to handle @@ -324,6 +324,8 @@ data InertSet -- See `resetInertCans` , inert_cycle_breakers :: CycleBreakerVarStack + -- The equalities for /given/ cycle breakers, GivenCycleBreakerTvs + -- See Note [ , inert_famapp_cache :: FunEqMap Reduction -- Just a hash-cons cache for use when reducing family applications @@ -1942,7 +1944,8 @@ prohibitedSuperClassSolve given_loc wanted_loc {- ********************************************************************* * * - Cycle breakers + Given Cycle breakers + See Note [Type equality cycles: Givens] in GHC.Tc.Solver.Equality * * ********************************************************************* -} ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2344,12 +2344,12 @@ checkTypeEq ev eq_rel lhs rhs = given_pred = mkNomEqPred fam_app new_ty given_term = evCoercion $ mkNomReflCo new_ty -- See Detail (4) of Note - -- See Detail (7) of the Note + -- See Detail (7) of Note [Type equality cycles: implementation] cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin ------------------------- -- | Fill in CycleBreakerTvs with the variables they stand for. --- See Note [Type equality cycles] in GHC.Tc.Solver.Equality +-- See Note [Type equality cycles: Givens] in GHC.Tc.Solver.Equality restoreTyVarCycles :: InertSet -> TcM () restoreTyVarCycles is = TcM.liftZonkM ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -726,11 +726,11 @@ cloneMetaTyVarName name metaInfoToTyVarName :: MetaInfo -> FastString metaInfoToTyVarName meta_info = case meta_info of - TauTv -> fsLit "t" - TyVarTv -> fsLit "a" - RuntimeUnkTv -> fsLit "r" - CycleBreakerTv -> fsLit "b" - ConcreteTv {} -> fsLit "c" + TauTv -> fsLit "t" + TyVarTv -> fsLit "a" + RuntimeUnkTv -> fsLit "r" + GivenCycleBreakerTv -> fsLit "b" + ConcreteTv {} -> fsLit "c" newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar newAnonMetaTyVar mi = newNamedAnonMetaTyVar (metaInfoToTyVarName mi) mi @@ -824,7 +824,7 @@ cloneAnonMetaTyVar info tv kind -- in GHC.Tc.Solver.Equality. newCycleBreakerTyVar :: TcKind -> TcM TcTyVar newCycleBreakerTyVar kind - = do { details <- newMetaDetails CycleBreakerTv + = do { details <- newMetaDetails GivenCycleBreakerTv ; name <- newMetaTyVarName (fsLit "cbv") ; return (mkTcTyVar name kind details) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -688,9 +688,10 @@ data MetaInfo | RuntimeUnkTv -- ^ A unification variable used in the GHCi debugger. -- It /is/ allowed to unify with a polytype, unlike TauTv - | CycleBreakerTv -- ^ Used to fix occurs-check problems in Givens - -- See Note [Type equality cycles] in - -- GHC.Tc.Solver.Equality + | GivenCycleBreakerTv -- ^ Used to fix occurs-check problems in Givens + -- Never used for Wanteds + -- See Note [Type equality cycles] in + -- GHC.Tc.Solver.Equality | ConcreteTv ConcreteTvOrigin -- ^ A unification variable that can only be unified @@ -705,11 +706,11 @@ instance Outputable MetaDetails where ppr (Indirect ty) = text "Indirect" <+> ppr ty instance Outputable MetaInfo where - ppr TauTv = text "tau" - ppr TyVarTv = text "tyv" - ppr RuntimeUnkTv = text "rutv" - ppr CycleBreakerTv = text "cbv" - ppr (ConcreteTv {}) = text "conc" + ppr TauTv = text "tau" + ppr TyVarTv = text "tyv" + ppr RuntimeUnkTv = text "rutv" + ppr GivenCycleBreakerTv = text "cbv" + ppr (ConcreteTv {}) = text "conc" -- | What caused us to create a 'ConcreteTv' metavariable? -- See Note [ConcreteTv] in GHC.Tc.Utils.Concrete. @@ -1299,7 +1300,7 @@ isRuntimeUnkTyVar tv isCycleBreakerTyVar tv | isTyVar tv -- See Note [Coercion variables in free variable lists] - , MetaTv { mtv_info = CycleBreakerTv } <- tcTyVarDetails tv + , MetaTv { mtv_info = GivenCycleBreakerTv } <- tcTyVarDetails tv = True | otherwise @@ -1350,8 +1351,8 @@ metaTyVarInfo tv isTouchableInfo :: MetaInfo -> Bool isTouchableInfo info - | CycleBreakerTv <- info = False - | otherwise = True + | GivenCycleBreakerTv <- info = False + | otherwise = True metaTyVarTcLevel :: TcTyVar -> TcLevel metaTyVarTcLevel tv ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -103,7 +103,6 @@ import GHC.Types.Id( idType ) import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Var.FV import GHC.Types.Basic import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -120,7 +119,6 @@ import GHC.Data.Maybe (firstJusts) import Control.Monad import Data.Functor.Identity (Identity(..)) import qualified Data.List.NonEmpty as NE -import Data.Monoid as DM ( Any(..) ) import qualified Data.Semigroup as S ( (<>) ) import Data.Traversable (for) @@ -3143,6 +3141,7 @@ uUnfilledVar2 env@(UE { u_defer = def_eq_ref, u_given_eq_lvl = given_eq_lvl }) do { traceTc "uUnfilledVar2 not ok" $ vcat [ text "tv1:" <+> ppr tv1 , text "ty2:" <+> ppr ty2 + , text "given_eq_lvl:" <+> ppr given_eq_lvl , text "simple-unify-chk:" <+> ppr (simpleUnifyCheck UC_OnTheFly given_eq_lvl tv1 ty2) ] -- Occurs check or an untouchable: just defer @@ -3236,16 +3235,17 @@ lhsPriority tv -> 5 -- Eliminate instantiation variables first | otherwise -> case info of - CycleBreakerTv -> 0 - TyVarTv -> 1 - ConcreteTv {} -> 2 - TauTv -> 3 - RuntimeUnkTv -> 4 + GivenCycleBreakerTv -> 0 + TyVarTv -> 1 + ConcreteTv {} -> 2 + TauTv -> 3 + RuntimeUnkTv -> 4 {- Note [Unification preconditions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Question: given a homogeneous equality (alpha ~# ty), when is it OK to unify alpha := ty? + (This note only applies to /homogeneous/ equalities, in which both sides have the same kind.) @@ -3285,7 +3285,7 @@ There are five reasons not to unify: structured type. So if 'ty' is a structured type, such as (Maybe x), don't unify. - * CycleBreakerTv: never unified, except by restoreTyVarCycles. + * GivenCycleBreakerTv: never unified, except by restoreGivenCycles. 4. (CONCRETE) A ConcreteTv can only unify with a concrete type, by definition. @@ -3354,6 +3354,14 @@ Needless to say, all there are wrinkles: GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier to unify in-place, with no floating. +* (COERCIONS) What if there are coercions in the RHS? E.g. + alpha ~ (ty |> co) + or alpha ~ (ty co) + We only recurse into the `coercionType` of `co` rather than `co` itself. + Why? Mainly because `co` might be a coercion hole, in which case we /can't/ + recurse into the coercion that will eventually fill the hole. This came + up in #26543. + Note [TyVar/TyVar orientation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See also Note [Fundeps with instances, and equality orientation] @@ -3382,7 +3390,7 @@ So we look for a positive reason to swap, using a three-step test: touchable and can be unified. Tie-breaking rules for MetaTvs: - - CycleBreakerTv: This is essentially a stand-in for another type; + - GivenCycleBreakerTv: This is essentially a stand-in for another type; it's untouchable and should have the same priority as a skolem: 0. - TyVarTv: These can unify only with another tyvar, but we can't unify @@ -3588,7 +3596,6 @@ matchExpectedFunKind hs_ty n k = go n k data UnifyCheckCaller = UC_OnTheFly -- Called from the on-the-fly unifier - | UC_QuickLook -- Called from Quick Look | UC_Solver -- Called from constraint solver -- | The result type of 'simpleUnifyCheck'. @@ -3619,35 +3626,29 @@ simpleUnifyCheck :: UnifyCheckCaller -> TcLevel -> TcTyVar -> TcType -> SimpleUn -- unification might still be OK, but it'll take more work to do -- (use the full 'checkTypeEq'). -- +-- See Note [simpleUnifyCheck] +-- -- * Rejects if lhs_tv occurs in rhs_ty (occurs check) -- * Rejects foralls unless -- lhs_tv is RuntimeUnk (used by GHCi debugger) --- or is a QL instantiation variable -- * Rejects a non-concrete type if lhs_tv is concrete -- * Rejects type families unless fam_ok=True -- * Does a level-check for type variables, to avoid skolem escape -- -- This function is pretty heavily used, so it's optimised not to allocate simpleUnifyCheck caller given_eq_lvl lhs_tv rhs - | not $ touchabilityTest given_eq_lvl lhs_tv - = SUC_CannotUnify - | not $ checkTopShape lhs_info rhs - = SUC_CannotUnify - | rhs_is_ok rhs - = SUC_CanUnify - | otherwise - = SUC_NotSure + | not $ touchabilityTest given_eq_lvl lhs_tv = SUC_CannotUnify + | not $ checkTopShape lhs_info rhs = SUC_CannotUnify + | not (rhs_is_bad rhs) = SUC_CanUnify + | otherwise = SUC_NotSure where - lhs_info = metaTyVarInfo lhs_tv - - !(occ_in_ty, occ_in_co) = mkOccFolders (tyVarName lhs_tv) - + lhs_info = metaTyVarInfo lhs_tv lhs_tv_lvl = tcTyVarLevel lhs_tv lhs_tv_is_concrete = isConcreteTyVar lhs_tv + lhs_tv_nm = tyVarName lhs_tv - forall_ok = case caller of - UC_QuickLook -> isQLInstTyVar lhs_tv - _ -> isRuntimeUnkTyVar lhs_tv + -- See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect, esp (RUT1). + forall_ok = isRuntimeUnkTyVar lhs_tv -- This fam_ok thing relates to a very specific perf problem -- See Note [Prevent unification with type families] @@ -3656,58 +3657,74 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs -- see if it bites us) fam_ok = case caller of UC_Solver -> True - UC_QuickLook -> True UC_OnTheFly -> False - rhs_is_ok (TyVarTy tv) - | lhs_tv == tv = False - | tcTyVarLevel tv `strictlyDeeperThan` lhs_tv_lvl = False - | lhs_tv_is_concrete, not (isConcreteTyVar tv) = False - | occ_in_ty $! (tyVarKind tv) = False - | otherwise = True - - rhs_is_ok (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) - | not forall_ok, isInvisibleFunArg af = False - | otherwise = rhs_is_ok w && rhs_is_ok a && rhs_is_ok r - - rhs_is_ok (TyConApp tc tys) - | lhs_tv_is_concrete, not (isConcreteTyCon tc) = False - | not forall_ok, not (isTauTyCon tc) = False - | not fam_ok, not (isFamFreeTyCon tc) = False - | otherwise = all rhs_is_ok tys - - rhs_is_ok (ForAllTy (Bndr tv _) ty) - | forall_ok = rhs_is_ok (tyVarKind tv) && (tv == lhs_tv || rhs_is_ok ty) - | otherwise = False - - rhs_is_ok (AppTy t1 t2) = rhs_is_ok t1 && rhs_is_ok t2 - rhs_is_ok (CastTy ty co) = not (occ_in_co co) && rhs_is_ok ty - rhs_is_ok (CoercionTy co) = not (occ_in_co co) - rhs_is_ok (LitTy {}) = True - - -mkOccFolders :: Name -> (TcType -> Bool, TcCoercion -> Bool) --- These functions return True --- * if lhs_tv occurs (incl deeply, in the kind of variable) --- * if there is a coercion hole --- No expansion of type synonyms -mkOccFolders lhs_tv = ( getAny . runFVTop . check_ty - , getAny . runFVTop . check_co) - where - check_ty :: Type -> FV BoundVars Any - !(check_ty, _, check_co, _) = foldTyCo occ_folder + rhs_tcv_is_bad tcv + -- c.f. checkTyVar, the TEFTyVar case + | isCoVar tcv = occ_check + | tcTyVarLevel tcv `strictlyDeeperThan` lhs_tv_lvl = True + | lhs_tv_is_concrete, not (isConcreteTyVar tcv) = True + | occ_check = True + | otherwise = False + where + occ_check = simpleOccursCheck lhs_tv_nm tcv + + rhs_is_bad (TyVarTy tv) = rhs_tcv_is_bad tv + + rhs_is_bad (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) + | not forall_ok, isInvisibleFunArg af = True + | otherwise = rhs_is_bad w || rhs_is_bad a || rhs_is_bad r + + rhs_is_bad (TyConApp tc tys) + | lhs_tv_is_concrete, not (isConcreteTyCon tc) = True + | not forall_ok, not (isTauTyCon tc) = True + | not fam_ok, not (isFamFreeTyCon tc) = True + | otherwise = any rhs_is_bad tys + + rhs_is_bad (ForAllTy (Bndr tv _) ty) + | not forall_ok = True + | rhs_is_bad (tyVarKind tv) = True + | tv /= lhs_tv, rhs_is_bad ty = True + | otherwise = False + + rhs_is_bad (AppTy t1 t2) = rhs_is_bad t1 || rhs_is_bad t2 + rhs_is_bad (CastTy ty co) = co_is_bad co || rhs_is_bad ty + rhs_is_bad (CoercionTy co) = co_is_bad co + rhs_is_bad (LitTy {}) = False + + -- Coercions: see Note [Occurs check and coercions] + co_is_bad co = anyFreeVarsOfCo rhs_tcv_is_bad co + +{- Note [simpleUnifyCheck] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +The function `simpleUnifyCheck` is a simple, /fast/ check for unifying (tv ~ rhs). +It can return a definite decision (SUC_CannotUnify of SUC_CanUnify), or uncertainty +(SUC_NotSure). In the latter case we will later use `checkTyEqRhs` to resolve. +In particular, `simpleUnifyCheck`: + +* Rejects if lhs_tv occurs in rhs_ty +* Rejects foralls unless + lhs_tv is RuntimeUnk (used by GHCi debugger) +* Rejects a non-concrete type if lhs_tv is concrete +* Rejects type families unless fam_ok=True +* Does a level-check for type variables, to avoid skolem escape - occ_folder :: TyCoFolder (FV BoundVars Any) - occ_folder = TyCoFolder { tcf_view = noView -- Don't expand synonyms - , tcf_tyvar = do_tcv, tcf_covar = do_tcv - , tcf_hole = do_hole - , tcf_tycobinder = addBndrFV } +This function is pretty heavily used, so it's optimised not to allocate. - do_tcv v = (MkFV $ \ bvs -> - Any (not (v `elemVarSet` bvs) && tyVarName v == lhs_tv)) - `mappend` check_ty (varType v) +Note [Occurs check and coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +What if we have + alpha ~ Int |> (CoHole ch :: Type ~ blah) + +Clearly we want to check that `alpha` doesn't appear free in `blah`. But even if +it doesn't, what if `ch` is later filled in with a coercion mentioning `alpha`? +Tht would be bad: we'd get an infinite structure. - do_hole _hole = MkFV $ \ _bvs -> DM.Any True -- Reject coercion holes +The Right Thing to do is to check for a loop when (later) filling in `ch`. +We don't do that right now, and it's very obscure. But in `simpleUnifyCheck` +we just look in the free vars of the /kind/ of the hole, which is what +`anyFreeVarsOfCo` does. +-} {- ********************************************************************* * * @@ -4081,13 +4098,14 @@ wantConcreteCheck = \case -- where @cbv@ is a fresh loop-breaker tyvar (for Given), or -- just a fresh 'TauTv' (for Wanted) famAppBreaker :: FamAppBreaker a -> TcType -> TcM (PuResult a Reduction) -famAppBreaker BreakGiven fam_app +famAppBreaker BreakGiven fam_app -- Givens = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) ; return (PuOK (unitBag (new_tv, fam_app)) (mkReflRedn Nominal (mkTyVarTy new_tv))) } -- Why reflexive? See Detail (4) of Note [Type equality cycles] -- in GHC.Tc.Solver.Equality -famAppBreaker (BreakWanted ev lhs_tv) fam_app + +famAppBreaker (BreakWanted ev lhs_tv) fam_app -- Wanteds -- Occurs check or skolem escape; so flatten = do { reason <- checkPromoteFreeVars cteInsolubleOccurs (tyVarName lhs_tv) lhs_tv_lvl @@ -4222,10 +4240,16 @@ Notably, it can check for things like: Its specific behaviour is governed by the `TyEqFlags` that are passed to it; see Note [TyEqFlags]. -Note, however, that `checkTyEqRhs` specifically does /not/ check for: - * Touchability of the LHS (in the case of a unification variable) - * Shape of the LHS (e.g. we can't unify Int with a TyVarTv) -These things are checked by `simpleUnifyCheck`. +Wrinkles + +(CTER1) Note, however, that `checkTyEqRhs` specifically does /not/ check for: + * Touchability of the LHS (in the case of a unification variable) + * Shape of the LHS (e.g. we can't unify Int with a TyVarTv) + These things are checked by `simpleUnifyCheck`. + +(CTER2) Also `checkTyEqRhs` does not need to worry about RuntimeUnkTvs, because + the solver is never called on constraints involving them. See (RUT1) in + Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect. -} @@ -4283,6 +4307,7 @@ check_ty_eq_rhs :: forall m a => TyEqFlags m a -> TcType -- Already zonked -> m (PuResult a Reduction) +{-# INLINEABLE check_ty_eq_rhs #-} check_ty_eq_rhs flags ty = case ty of LitTy {} -> return $ okCheckRefl ty @@ -4313,7 +4338,7 @@ check_ty_eq_rhs flags ty ; return (mkReflCoRedn Nominal <$> co_res) } ForAllTy {} -> return $ PuFail impredicativeProblem -- Not allowed (TyEq:F) -{-# INLINEABLE check_ty_eq_rhs #-} + -- No need to worry about RuntimeUnkTv ------------------- checkCo :: Monad m => TyEqFlags m a -> Coercion -> m (PuResult a Coercion) @@ -4337,7 +4362,10 @@ checkCo flags co = -- Occurs check (can promote) | OC_Check lhs_tv occ_prob <- occ , LC_Promote { lc_lvlp = lhs_tv_lvl } <- lc - -> do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) + -> do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl $ + tyCoVarsOfCo co + -- See Note [Occurs check and coercions] + -- and Note [checkCo] (2) ; return $ if cterHasNoProblem reason then pure co @@ -4634,7 +4662,7 @@ checkTyVar flags occ_tv -- so the only reason for a filled meta-tyvar is promotion else do_rhs_checks - [ simpleOccursCheck occ occ_tv + [ tyVarOccursCheck occ occ_tv , tyVarLevelCheck lc occ_tv , tyVarConcretenessCheck conc occ_tv ] } @@ -4692,17 +4720,24 @@ promotionDone occ_tv _ (CC_Promote {}) = isFilledMetaTyVar occ_tv promotionDone _ _ _ = return False --------------------- -simpleOccursCheck :: OccursCheck -> TcTyVar -> TyVarCheckResult m +tyVarOccursCheck :: OccursCheck -> TcTyCoVar -> TyVarCheckResult m -- ^ The "interpreter" for 'OccursCheck' -simpleOccursCheck OC_None _ - = TyVarCheck_Success -simpleOccursCheck (OC_Check lhs_tv occ_prob) occ_tv - | lhs_tv == tyVarName occ_tv || check_kind (tyVarKind occ_tv) - = TyVarCheck_Error (cteProblem occ_prob) - | otherwise +-- Check for an occurrence of lhs_tv in occ_tv /or/ its kind +tyVarOccursCheck OC_None _ = TyVarCheck_Success +tyVarOccursCheck (OC_Check { occurs_tv_name = lhs_tv, occurs_problem = prob }) occ_tcv + | simpleOccursCheck lhs_tv occ_tcv = TyVarCheck_Error (cteProblem prob) + | otherwise = TyVarCheck_Success + +simpleOccursCheck :: Name -> TyCoVar -> Bool +-- Check for an occurrence of lhs_tv in occ_tv /or/ its kind +-- True <=> occurs check fires +simpleOccursCheck lhs_tv occ_tcv + = is_bad occ_tcv || anyFreeVarsOfType is_bad (varType occ_tcv) + -- anyFreeVarsOfType looks at the /deep/ free vars of the type where - (check_kind, _) = mkOccFolders lhs_tv + is_bad :: TyCoVar -> Bool + is_bad occ_tcv = lhs_tv == tyVarName occ_tcv ------------------------- tyVarLevelCheck :: LevelCheck m -> TcTyVar -> TyVarCheckResult m @@ -4823,7 +4858,7 @@ checkTopShape info xi RuntimeUnk -> True MetaTv { mtv_info = TyVarTv } -> True _ -> False - CycleBreakerTv -> False -- We never unify these + GivenCycleBreakerTv -> False -- We never unify these _ -> True -------------------------------------------------------------------------------- @@ -5136,14 +5171,14 @@ mightEqualLater inert_set given_pred given_loc wanted_pred wanted_loc -- True for TauTv and TyVarTv (and RuntimeUnkTv) meta-tyvars -- (as they can be unified) - -- and also for CycleBreakerTvs that mentions meta-tyvars + -- and also for GivenCycleBreakerTvs that mentions meta-tyvars mentions_meta_ty_var :: TyVar -> Bool mentions_meta_ty_var tv | isMetaTyVar tv = case metaTyVarInfo tv of -- See Examples 8 and 9 in the Note - CycleBreakerTv -> anyFreeVarsOfType mentions_meta_ty_var - (lookupCycleBreakerVar tv inert_set) + GivenCycleBreakerTv -> anyFreeVarsOfType mentions_meta_ty_var + (lookupCycleBreakerVar tv inert_set) _ -> True | otherwise = False @@ -5186,7 +5221,7 @@ We want to solve w1 using g1 and g2. The presence of g3 is irrelevant, because we cannot unify 'f[tau:1] v[tau:1]' and 'g[sk:1] x[sk:3]' due to skolem escape. -} --- | Return the type family application a CycleBreakerTv maps to. +-- | Return the type family application a GivenCycleBreakerTv maps to. lookupCycleBreakerVar :: TcTyVar -- ^ cbv, must be a CycleBreakerTv -> InertSet -> TcType -- ^ type family application the cbv maps to ===================================== compiler/GHC/Types/Var/FV.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.FV ( runFVSelective, runFVSelectiveList, runFVSelectiveSet, InterestingVarFun, - addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, + updEnvFV, addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, emptyFV, -- or `mempty` unionFV, -- or `mappend` mapUnionFV @@ -138,7 +138,7 @@ type BoundVars = TyCoVarSet type VarSetFV = FV BoundVars (EndoOS TyCoVarSet) type DVarSetFV = FV BoundVars (EndoOS DTyCoVarSet) -type SelectiveDFV = FV (InterestingVarFun, BoundVars) (EndoOS DVarSet) +type SelectiveDFV = FV (BoundVars, InterestingVarFun) (EndoOS DVarSet) -- VarSetFV: collects a VarSet -- DVarSetFV: collects a DVarSet (deterministic) -- SelectiveDFV: selectively collects a DVarSet @@ -158,9 +158,14 @@ pattern MkFV :: (env -> acc) -> FV env acc {-# COMPLETE MkFV #-} pattern MkFV f <- MkFV' f where - MkFV f = MkFV' (oneShot f) + MkFV f = MkFV' (oneShot (\env -> env `seq` f env)) -- oneShot: this is the core of the one-shot trick! -- Note [The one-shot state monad trick] in GHC.Utils.Monad. + -- + -- seq: this is /important/: it makes the function strict. + -- When the `env` is a pair (as it is in anyFreeVarsOfType), that means + -- we get good worker/wrapper splitting. Without it we get extra boxed + -- pairs allocated by `anyFreeVarsOfType`. instance Semigroup a => Semigroup (FV env a) where (<>) = unionFV @@ -174,28 +179,28 @@ emptyFV = MkFV (\_ -> mempty) unionFV :: Semigroup a => FV env a -> FV env a -> FV env a unionFV (MkFV' f1) (MkFV' f2) = MkFV (\env -> f1 env <> f2 env) -upd_bndrs_fv :: (env -> env) -> FV env a -> FV env a -{-# INLINE addBndrFV #-} -upd_bndrs_fv upd f = MkFV (\bvs -> runFV f $! upd bvs) +updEnvFV :: (env -> env) -> FV env a -> FV env a +updEnvFV upd f = MkFV (\bvs -> runFV f $! upd bvs) -- Strict application to avoid making a thunk addBndrFV :: TyCoVar -> FV BoundVars a -> FV BoundVars a -addBndrFV tcv = upd_bndrs_fv (\bvs -> extendVarSet bvs tcv) +{-# INLINE addBndrFV #-} +addBndrFV tcv = updEnvFV (\bvs -> extendVarSet bvs tcv) addBndrsFV :: [Var] -> FV BoundVars a -> FV BoundVars a -addBndrsFV tcvs = upd_bndrs_fv (\bvs -> extendVarSetList bvs tcvs) +addBndrsFV tcvs = updEnvFV (\bvs -> extendVarSetList bvs tcvs) -addBndrSelectiveFV :: TyCoVar -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrSelectiveFV :: TyCoVar -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrSelectiveFV tcv - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSet bvs tcv + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSet bvs tcv -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) -addBndrsSelectiveFV :: [Var] -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrsSelectiveFV :: [Var] -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrsSelectiveFV bs - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSetList bvs bs + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSetList bvs bs -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) mapUnionFV :: (Foldable t, Monoid acc) => (a -> FV env acc) -> t a -> FV env acc @@ -221,7 +226,7 @@ runTyCoVarsDSet f = runFVAcc f emptyDVarSet runFVSelective :: InterestingVarFun -> SelectiveDFV -> DVarSet runFVSelective interesting f - = runEndoOS (runFV f (interesting, emptyVarSet)) emptyDVarSet + = runEndoOS (runFV f (emptyVarSet, interesting)) emptyDVarSet runFVSelectiveList :: InterestingVarFun -> SelectiveDFV -> [Var] runFVSelectiveList interesting f = dVarSetElems (runFVSelective interesting f) ===================================== testsuite/tests/default/default-fail05.stderr ===================================== @@ -1,45 +1,45 @@ default-fail05.hs:11:10: error: [GHC-39999] - • Ambiguous type variable ‘f0’ arising from a use of ‘toList’ - prevents the constraint ‘(Foldable f0)’ from being solved. - Probable fix: use a type annotation to specify what ‘f0’ should be. + • Ambiguous type variable ‘t0’ arising from a use of ‘toList’ + prevents the constraint ‘(Foldable t0)’ from being solved. + Probable fix: use a type annotation to specify what ‘t0’ should be. Potentially matching instances: instance Foldable (Either a) -- Defined in ‘GHC.Internal.Data.Foldable’ instance Foldable Maybe -- Defined in ‘GHC.Internal.Data.Foldable’ ...plus three others - ...plus 26 instances involving out-of-scope types + ...plus 11 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the first argument of ‘($)’, namely ‘toList’ In the first argument of ‘print’, namely ‘(toList $ pure 21)’ In a stmt of a 'do' block: print (toList $ pure 21) default-fail05.hs:11:19: error: [GHC-39999] - • Ambiguous type variable ‘f0’ arising from a use of ‘pure’ - prevents the constraint ‘(Applicative f0)’ from being solved. - Probable fix: use a type annotation to specify what ‘f0’ should be. + • Ambiguous type variable ‘t0’ arising from a use of ‘pure’ + prevents the constraint ‘(Applicative t0)’ from being solved. + Probable fix: use a type annotation to specify what ‘t0’ should be. Potentially matching instances: instance Applicative IO -- Defined in ‘GHC.Internal.Base’ instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ ...plus six others - ...plus 9 instances involving out-of-scope types + ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘($)’, namely ‘pure 21’ In the first argument of ‘print’, namely ‘(toList $ pure 21)’ In a stmt of a 'do' block: print (toList $ pure 21) default-fail05.hs:12:3: error: [GHC-39999] - • Ambiguous type variable ‘t0’ arising from a use of ‘traverse’ - prevents the constraint ‘(Traversable t0)’ from being solved. + • Ambiguous type variable ‘t1’ arising from a use of ‘traverse’ + prevents the constraint ‘(Traversable t1)’ from being solved. Relevant bindings include - main :: IO (t0 ()) (bound at default-fail05.hs:10:1) - Probable fix: use a type annotation to specify what ‘t0’ should be. + main :: IO (t1 ()) (bound at default-fail05.hs:10:1) + Probable fix: use a type annotation to specify what ‘t1’ should be. Potentially matching instances: instance Traversable (Either a) -- Defined in ‘GHC.Internal.Data.Traversable’ instance Traversable Maybe -- Defined in ‘GHC.Internal.Data.Traversable’ ...plus three others - ...plus 28 instances involving out-of-scope types + ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: traverse print (pure 42) In the expression: @@ -51,16 +51,16 @@ default-fail05.hs:12:3: error: [GHC-39999] traverse print (pure 42) default-fail05.hs:12:19: error: [GHC-39999] - • Ambiguous type variable ‘t0’ arising from a use of ‘pure’ - prevents the constraint ‘(Applicative t0)’ from being solved. + • Ambiguous type variable ‘t1’ arising from a use of ‘pure’ + prevents the constraint ‘(Applicative t1)’ from being solved. Relevant bindings include - main :: IO (t0 ()) (bound at default-fail05.hs:10:1) - Probable fix: use a type annotation to specify what ‘t0’ should be. + main :: IO (t1 ()) (bound at default-fail05.hs:10:1) + Probable fix: use a type annotation to specify what ‘t1’ should be. Potentially matching instances: instance Applicative IO -- Defined in ‘GHC.Internal.Base’ instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’ ...plus six others - ...plus 9 instances involving out-of-scope types + ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘traverse’, namely ‘(pure 42)’ In a stmt of a 'do' block: traverse print (pure 42) ===================================== testsuite/tests/ghci.debugger/scripts/T14628.stderr ===================================== @@ -1,9 +1,9 @@ - -<interactive>:4:17: error: [GHC-25897] +<interactive>:4:7: error: [GHC-25897] • Couldn't match type ‘m’ with ‘(,) a0’ - Expected: StateT Int ((,) a0) () - Actual: StateT Int m () + Expected: (a0, ((), Int)) + Actual: m ((), Int) ‘m’ is an interactive-debugger skolem - • In the first argument of ‘runStateT’, namely ‘_result’ - In the second argument of ‘($)’, namely ‘runStateT _result 0’ + • In the second argument of ‘($)’, namely ‘runStateT _result 0’ In the expression: snd $ runStateT _result 0 + In an equation for ‘it’: it = snd $ runStateT _result 0 + ===================================== testsuite/tests/impredicative/T27917.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE ImpredicativeTypes #-} +module T27917 where + +pair :: forall p q. Maybe p -> q -> (p, q) +pair _ _ = undefined + +ids :: [forall a. a -> a] +ids = [] + +use :: forall s. s -> () +use _ = () + +isMaybe :: Maybe a -> () +isMaybe (Just {}) = () + +-- #27917 reported that foo1 was accepted but foo2 was rejected! +foo1 = \y -> (isMaybe y, use (pair y ids)) +foo2 = \y -> (use (pair y ids), isMaybe y) + +{- y :: Maybe alpha + pair @k1 @k2 y ids + +Maybe k1 ~ Maybe alpha +k2 ~ [ forall a. a->a ] + +use @ss (pair ...) + +ss ~ (k1, [forall a. a->a]) +-} ===================================== testsuite/tests/impredicative/all.T ===================================== @@ -22,3 +22,4 @@ test('T17332', normal, compile_fail, ['']) test('expr-sig', normal, compile, ['']) test('Dict', normal, compile, ['']) test('T24676', normal, compile, ['']) +test('T27917', normal, compile, ['']) ===================================== testsuite/tests/indexed-types/should_fail/T1897b.stderr ===================================== @@ -1,14 +1,14 @@ T1897b.hs:16:1: error: [GHC-83865] - • Couldn't match type: Depend b0 - with: Depend b - Expected: t (Depend b) -> Bool - Actual: t (Depend b0) -> Bool + • Couldn't match type: Depend a0 + with: Depend a + Expected: t (Depend a) -> Bool + Actual: t (Depend a0) -> Bool Note: ‘Depend’ is a non-injective type family. - The type variable ‘b0’ is ambiguous + The type variable ‘a0’ is ambiguous • In the ambiguity check for the inferred type for ‘isValid’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the inferred type - isValid :: forall {t :: * -> *} {b}. - (Foldable t, Bug b) => - t (Depend b) -> Bool + isValid :: forall {t :: * -> *} {a}. + (Foldable t, Bug a) => + t (Depend a) -> Bool ===================================== testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs ===================================== @@ -22,7 +22,7 @@ it mentions b in its RHS. It thus triggers Note [Type equality cycles] in GHC.Tc.Solver.Equality. That Note says we change the situation to [G] b ~ cbv GhcPs [G] Body b ~ cbv -for some fresh CycleBreakerTv cbv. Now, our original equality looks to be let-like, +for some fresh GivenCycleBreakerTv cbv. Now, our original equality looks to be let-like, but the new cbv equality is *not* let-like -- note that the variable is on the RHS. The solution is to consider any equality whose free variables are all at the current level to not stop equalities from floating. These are called *local*. Because both ===================================== testsuite/tests/typecheck/should_compile/T26543_orig.hs ===================================== @@ -0,0 +1,36 @@ +-- This test is from the Description of #26543 + +{-# LANGUAGE GHC2024, TypeAbstractions, AllowAmbiguousTypes, NoImplicitPrelude, + TypeFamilies, UndecidableInstances #-} +module T26543_orig where + +import Data.Kind +import Control.Applicative (Applicative(..)) +import Prelude (type (~), ($)) + +type CAT k = k -> k -> Type + +type family (~>) :: CAT k +type family Ob (a :: k) :: Constraint +type family UN (w :: j -> k) (wa :: k) :: j + +class HasBinaryProducts k where + type (a :: k) && (b :: k) :: k + withObProd :: (Ob (a :: k), Ob b) => ((Ob (a && b)) => r) -> r + (&&&) :: ((a :: k) ~> x) -> (a ~> y) -> (a ~> (x && y)) + +data AP (f :: Type -> Type) k = A k +type instance UN A (A k) = k + +type Ap :: CAT (AP f k) +data Ap a b where + Ap :: forall {k} a b f. (Ob a, Ob b) => f (a ~> b) -> Ap (A a :: AP f k) (A b) + +type instance (~>) = Ap +type instance Ob a = (a ~ A (UN A a), Ob (UN A a)) + +instance (Applicative f, HasBinaryProducts k) => HasBinaryProducts (AP f k) where + type a && b = A (UN A a && UN A b) + withObProd @(A a) @(A b) r = withObProd @k @a @b r + -- (&&&) :: Ap (a :: AP f k) x -> Ap a y -> Ap a (x && y) + Ap @_ @x f &&& Ap @_ @y g = withObProd @k @x @y $ Ap (liftA2 (&&&) f g) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -971,3 +971,5 @@ test('LazyFieldAnnotations', normal, compile, ['']) test('T27557', normal, compile, ['']) test('T27664', normal, compile, ['']) test('T27916', normal, compile, ['']) +test('T26543_orig', normal, compile, ['']) + ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -1,38 +1,11 @@ -T22707.hs:6:59: error: [GHC-25897] - • Couldn't match expected type ‘i1’ - with actual type ‘m0 - GHC.Internal.Types.LiftedRep GHC.Internal.Types.LiftedRep b0’ - ‘i1’ is a rigid type variable bound by - the type signature for: - t1 :: forall i2 o i1 a. Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) - at T22707.hs:5:1-47 - • In the expression: evalCont (t1 c) >>== \ ati1 -> return ati1 xa - In the second argument of ‘($)’, namely - ‘\ xa -> evalCont (t1 c) >>== \ ati1 -> return ati1 xa’ - In the second argument of ‘runCont’, namely - ‘(ati1tti2 $ \ xa -> evalCont (t1 c) >>== \ ati1 -> return ...)’ - • Relevant bindings include - ati1tti2 :: (a -> i1) -> i2 (bound at T22707.hs:6:16) - c :: Cont (i2 -> o) i1 a (bound at T22707.hs:6:4) - t1 :: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) - (bound at T22707.hs:6:1) - T22707.hs:6:72: error: [GHC-25897] - • Couldn't match type ‘o’ - with ‘m0 - GHC.Internal.Types.LiftedRep - GHC.Internal.Types.LiftedRep - (m0 GHC.Internal.Types.LiftedRep GHC.Internal.Types.LiftedRep b0)’ + • Couldn't match type ‘i2’ with ‘a -> i1’ Expected: Cont - ((a -> i1) - -> m0 - GHC.Internal.Types.LiftedRep - GHC.Internal.Types.LiftedRep - (m0 GHC.Internal.Types.LiftedRep GHC.Internal.Types.LiftedRep b0)) + ((a -> i1) -> m0 (a -> i1) (a -> i1) (m0 (a -> i1) (a -> i1) b0)) i1 a Actual: Cont (i2 -> o) i1 a - ‘o’ is a rigid type variable bound by + ‘i2’ is a rigid type variable bound by the type signature for: t1 :: forall i2 o i1 a. Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) at T22707.hs:5:1-47 @@ -40,6 +13,9 @@ T22707.hs:6:72: error: [GHC-25897] In the first argument of ‘evalCont’, namely ‘(t1 c)’ In the first argument of ‘(>>==)’, namely ‘evalCont (t1 c)’ • Relevant bindings include + xa :: a (bound at T22707.hs:6:53) + ati1tti2 :: (a -> m0 (a -> i1) (a -> i1) b0) -> a -> i1 + (bound at T22707.hs:6:16) c :: Cont (i2 -> o) i1 a (bound at T22707.hs:6:4) t1 :: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) (bound at T22707.hs:6:1) ===================================== testsuite/tests/typecheck/should_fail/T26543a.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ImpredicativeTypes, PolyKinds #-} + +-- Should be rejected via an occurs-check in the kinds, +-- but was erroneously accpeted with ImpredicativeTypes +-- See !16566 + +module T26543a where + +import Data.Kind +import Data.Proxy + +h :: forall k (m :: k -> Type) (a :: k). (Proxy k, Proxy (m a)) +h = (Proxy, Proxy) + +use2 :: forall t. (Proxy t, Proxy t) -> () +use2 _ = () + +test = use2 h ===================================== testsuite/tests/typecheck/should_fail/T26543a.stderr ===================================== @@ -0,0 +1,10 @@ +T26543a.hs:18:13: error: [GHC-27958] + • Couldn't match type ‘t0’ with ‘m0 a0’ + Expected: (Proxy t0, Proxy t0) + Actual: (Proxy t0, Proxy (m0 a0)) + Type variable kinds: + m0 :: t0 -> * + a0 :: t0 + • In the first argument of ‘use2’, namely ‘h’ + In the expression: use2 h + In an equation for ‘test’: test = use2 h ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -763,3 +763,4 @@ test('T26861', normal, compile_fail, ['']) test('T26862', normal, compile_fail, ['']) test('T27210', normal, compile_fail, ['']) test('T26532', normal, compile_fail, ['']) +test('T26543a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98900237aa2c89acd4776faaaed75e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98900237aa2c89acd4776faaaed75e… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] 2 commits: Refactor type and coercion substitution
by Simon Peyton Jones (＠simonpj) 11 Oct '26

11 Oct '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 2b54bf83 by Simon Peyton Jones at 2026-10-11T16:23:28+01:00 Refactor type and coercion substitution This MR refactors type and coercion substitution so that they use TyCoMapper, rather than hand-rolled code. Fundamentally it's a simple idea, but I had to do quite a bit of refactoring to make it fly. I got Claude to help me this this refactoring, but I paid careful attention to every line of code. Main changes: * New module GHC.Core.TyCo.Make which defines TyCoMapper, and a bunch of other simple "smart constructors" for types and coercions. See GHC.Core.TyCo.Rep Note [The Type-related module hierarchy], esp (TRM1) * The new TyCoMapper has new fields `tcm_tcapp_ty` and `tcm_tcapp_co` to handle type-constructor applications. These replace `tcm_tycon`. * Rewrite GHC.Core.TyCo.Subst to use TyCoMapper * Rewrite GHC.Core.Type.expandTypeSynonyms to use TyCoMapper. * Implement `seqType` and `seqCo` with TyCoFolder. To to this I had to add a `tcf_lit` field to TyCoFolder. * A new module GHC.Utils.StrictIdentity to define a strict identity monad, which itself is used for substTyCoMapper :: TyCoMapper Subst StrictIdentity * I removed an apparently-unused instance for Binary Levity Refactoring `seq` functions * In GHC.Core.Seq, redefine `seqOneShot`, `seqRuleInfo`, and friends to return `SeqResult`, a new type defined in GHC.Types.Baseic, rather than `()`. We can define a Monoid instance for `SeqResult` that does the right thing. * This has knock-on effects across the compiler. - - - - - ec61259f by Simon Peyton Jones at 2026-10-11T16:23:28+01:00 Refactor TyCoMapper to take a single monad; add StrictReaderT TyCoMapper used to be parameterised over both an environment and a monad, with fields like tcm_tyvar :: env -> TyVar -> m Type Now it is parameterised over just the monad: tcm_tyvar :: TyVar -> m Type If the mapping needs an environment, `m` is a reader monad over that environment. Many uses (e.g. zonkTcTypeMapper, swizzleMapper) need no environment at all, and used to pass a dummy (). The binder field becomes tcm_tycobinder :: forall r. TyCoVar -> ForAllTyFlag -> (TyCoVar -> m r) -> m r and runs the continuation in the extended environment. mapTyCoX is gone; only mapTyCo remains. To make this efficient, the reader monad must use the one-shot trick and be strict in the environment. So: * New module GHC.Utils.Monad.StrictReader defines newtype StrictReaderT r m a with hand-written instances. The builder of the pattern synonym `StrictReaderT` is a smart constructor that adds both `oneShot` and a bang on the environment, so every StrictReaderT computation is strict in the environment. See Note [Instances for StrictReaderT]. * ZonkT becomes type ZonkT = StrictReaderT ZonkEnv ZonkM becomes type ZonkM = StrictReaderT ZonkGblEnv IO replacing their own hand-written instances. * Substitution uses type SubstM = StrictReaderT Subst StrictIdentity substTyCoMapper :: TyCoMapper SubstM and similarly expandTypeSynonymMapper. * zonk_tycomapper :: TyCoMapper (ZonkT TcM) is now much simpler. * swizzleMapper uses StrictIdentity rather than Identity. * Module renaming, so that the strict monads are all peers in GHC.Utils.Monad: GHC.Utils.StrictIdentity ==> GHC.Utils.Monad.StrictIdentity GHC.Utils.Monad.State.Strict ==> GHC.Utils.Monad.StrictState alongside the new GHC.Utils.Monad.StrictReader. Co-Authored-By: Claude Opus 5.5 <noreply(a)anthropic.com> - - - - - 67 changed files: - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Cmm/GenericOpt.hs - compiler/GHC/Cmm/UniqueRenamer.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs - compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs - compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear/State.hs - compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/Stg/EnforceEpt/Rewrite.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Stg/Subst.hs - compiler/GHC/Tc/Deriv/Functor.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/Env.hs - compiler/GHC/Tc/Zonk/Monad.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/DSM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - + compiler/GHC/Utils/Monad/StrictIdentity.hs - + compiler/GHC/Utils/Monad/StrictReader.hs - compiler/GHC/Utils/Monad/State/Strict.hs → compiler/GHC/Utils/Monad/StrictState.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsParser.stdout - utils/check-exact/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8bfbf80390a6b99f78ce37fcd69a6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8bfbf80390a6b99f78ce37fcd69a6… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Propagate annotations to simple interfaces
by Marge Bot (＠marge-bot) 11 Oct '26

11 Oct '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d538cac9 by Facundo Domínguez at 2026-10-09T20:26:38-04:00 Propagate annotations to simple interfaces This allows annotations to be visible to plugins when run by haddock. The LiquidHaskell plugin needs the annotations, in particular. Fixes #26761 - - - - - 32c4f4ab by meooow25 at 2026-10-09T20:27:28-04:00 Bump containers submodule to 0.8.1 And fix affected tests. * T4086a: containers depends on template-haskell-lift now instead of template-haskell. * T22611: Updated to be less dependent on containers internals. - - - - - c786065e by sheaf at 2026-10-09T20:28:20-04:00 Use an explicit pattern match in toIfaceIdDetails The old wildcard pattern let this code bit rot: it did not properly account for recently added 'IdDetails' such as 'RepPolyId', which resulted in spurious 'pprTrace' messages that could even pollute HLS sessions. Fixes #23785 - - - - - e7cacf59 by sheaf at 2026-10-09T20:29:09-04:00 Take into account ifKind in freeNamesIfDecl Commit 3c2f4bb4 added the 'ifKind' field to various constructors of 'IfaceDecl', which preserves the original kind (before type synonym expansion) for better error messages. However, that commit forgot to update 'freeNamesIfDecl' correspondingly. This could result in a "urk! lookup local fingerpring" crash when e.g. a type's kind uses a type synonym defined later, as we failed to add a dependency on the type synonym during dependency analysis. Fixes #27916 - - - - - 10620b36 by Simon Peyton Jones at 2026-10-11T09:28:30-04:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In `GHC.Tc.Errors.reportWanteds` we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. Main changes * Instead of /predicting/ when an error will be reported, we set `cec_error_reported` when an error is /actually/ reported. (I renamed it from `cec_suppress` to reflect this change.) Now errors are suppressed only when a preceding error has actually been reported. Simpler and more robust. See `Note [cec_error_reported: suppressing less-serious errors]` The big changes are in `reportWanteds` which looks very different. * New `Note [ei_suppress: suppressing confusing errors]` describes the (quite separate) `ei_suppress` mechanism for suppressing confusing errors, mainly arising from non-empty rewriter sets * In `tryTypeClassDefaulting`, instead of switching off type-class defaulting if there is an insoluble /anywhere/, we just switch it off locally when we find an insoluble sub-tree. See Note [When to do type-class defaulting] and (W5) in Note [ApproximateWC] * Greatly simplify `insolubleWantedCt`. * I made type-class-defaulting be a bit more eager, only switched off when a peer or ancestor (but not child) constraint is insoluble. See Note [When to do type-class defaulting]. Small refactorings * Rename `askNoErrs` to `askErrsFound` and flip its polarity * The code for "check if ei_suppress is true of all items" code is moved to `mkErrorItems` rather than in the large `reportWanteds`. * Code for `has_gadt_match` moves to `mkGivenErrorReporter`, rather than polluting the large `reportWanteds`. * Many tests with `-fdefer-type-errors` get more warnings, especially about ambiguous (Num a) constraints. This is by-design: see Note [Always warn with -fdefer-type-errors]. Previously GHC was not honouring this Note but now it is, hence the extra errors. - - - - - 0d80371f by Cheng Shao at 2026-10-11T09:28:31-04:00 compiler: ensure cross ghc --info output target unit ids Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in --info output do not match the target unit ids reported by ghc-pkg, breaking cross ghc release builds with hash-unit-ids when being used with cabal 3.18. This patch fixes it by making --info output target unit ids. Fixes #27919. Co-authored-by: Codex <codex(a)openai.com> - - - - - 84 changed files: - .gitlab/hello.hs - + changelog.d/26761 - + changelog.d/T23785 - + changelog.d/T27731 - + changelog.d/T27916 - + changelog.d/fix-cross-ghc-info-unit-id - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - libraries/containers - testsuite/tests/ghci/prog020/ghci.prog020a.stderr - testsuite/tests/ghci/prog020/ghci.prog020b.stderr - testsuite/tests/ghci/prog021/prog021a.stderr - testsuite/tests/ghci/prog021/prog021b.stderr - testsuite/tests/ghci/prog022/ghci.prog022a.stderr - testsuite/tests/ghci/prog022/ghci.prog022b.stderr - testsuite/tests/ghci/prog022/ghci.prog022c.stderr - testsuite/tests/ghci/prog022/ghci.prog022d.stderr - testsuite/tests/ghci/prog022/ghci.prog022e.stderr - testsuite/tests/ghci/prog022/ghci.prog022f.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/module/mod130.stderr - testsuite/tests/overloadedstrings/should_fail/T25926.stderr - testsuite/tests/overloadedstrings/should_fail/T27124.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/patsyn/should_fail/records-nofieldselectors.stderr - + testsuite/tests/plugins/T26761.hs - + testsuite/tests/plugins/T26761.stderr - + testsuite/tests/plugins/T26761Plugin.hs - + testsuite/tests/plugins/T26761a.hs - testsuite/tests/plugins/all.T - testsuite/tests/printer/T17697.stderr - testsuite/tests/rename/should_fail/T15607.stderr - testsuite/tests/rename/should_fail/T19843b.stderr - testsuite/tests/safeHaskell/ghci/p4.stderr - testsuite/tests/safeHaskell/ghci/p6.stderr - testsuite/tests/simplCore/should_compile/T22611.hs - testsuite/tests/simplCore/should_compile/T22611.stderr - + testsuite/tests/simplCore/should_compile/T22611a.hs - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/T11254.stderr - testsuite/tests/typecheck/should_compile/T15370.stderr - + testsuite/tests/typecheck/should_compile/T27916.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/ClassOperator.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T18851f.hs - + testsuite/tests/typecheck/should_fail/T18851f.stderr - testsuite/tests/typecheck/should_fail/T22940.stderr - testsuite/tests/typecheck/should_fail/T26823.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/T5691.stderr - testsuite/tests/typecheck/should_fail/T7437.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/mc24.stderr - testsuite/tests/typecheck/should_fail/tcfail019.stderr - testsuite/tests/typecheck/should_fail/tcfail189.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e8c4357c13d35972daf404e7ce70b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e8c4357c13d35972daf404e7ce70b… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/fix-cross-ghc-info-unit-id] compiler: ensure cross ghc --info output target unit ids
by Cheng Shao (＠TerrorJack) 11 Oct '26

11 Oct '26

Cheng Shao pushed to branch wip/fix-cross-ghc-info-unit-id at Glasgow Haskell Compiler / GHC Commits: 093abc71 by Cheng Shao at 2026-10-11T10:04:45+00:00 compiler: ensure cross ghc --info output target unit ids Previously, for cross ghcs, the base/ghc/ghc-internal unit ids in --info output do not match the target unit ids reported by ghc-pkg, breaking cross ghc release builds with hash-unit-ids when being used with cabal 3.18. This patch fixes it by making --info output target unit ids. Fixes #27919. Co-authored-by: Codex <codex(a)openai.com> - - - - - 10 changed files: - .gitlab/hello.hs - + changelog.d/fix-cross-ghc-info-unit-id - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== .gitlab/hello.hs ===================================== @@ -27,7 +27,11 @@ fakeSettings = sTargetPlatform = genericPlatform, sPlatformMisc = PlatformMisc {}, - sUnitSettings = UnitSettings { unitSettings_baseUnitId = stringToUnitId "base" } + sUnitSettings = UnitSettings + { unitSettings_baseUnitId = stringToUnitId "base" + , unitSettings_ghcUnitId = stringToUnitId "ghc" + , unitSettings_ghcInternalUnitId = stringToUnitId "ghc-internal" + } } fakeDynFlags :: DynFlags ===================================== changelog.d/fix-cross-ghc-info-unit-id ===================================== @@ -0,0 +1,4 @@ +section: compiler +synopsis: Fix a bug where unit ids in cross ghc --info output doesn't match ghc-pkg output, breaking cross ghc releases with cabal 3.18. +mrs: !16790 +issues: #27919 ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -546,7 +546,8 @@ opt_i dflags= toolSettings_opt_i $ toolSettings dflags setBaseUnitId :: String -> DynP () -setBaseUnitId s = upd $ \d -> d { unitSettings = UnitSettings (stringToUnitId s) } +setBaseUnitId s = upd $ \d -> d + { unitSettings = (unitSettings d) { unitSettings_baseUnitId = stringToUnitId s } } ----------------------------------------------------------------------------- @@ -3663,8 +3664,6 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), - ("Project Unit Id", cProjectUnitId), - ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Settings.hs ===================================== @@ -94,7 +94,11 @@ data Settings = Settings , sRawTarget :: Target } -data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId } +data UnitSettings = UnitSettings + { unitSettings_baseUnitId :: !UnitId + , unitSettings_ghcUnitId :: !UnitId + , unitSettings_ghcInternalUnitId :: !UnitId + } -- | Settings for other executables GHC calls. -- ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -142,6 +142,8 @@ initSettings top_dir = do ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" + ghcUnitId <- getSetting_raw "Project Unit Id" + ghcInternalUnitId <- getSetting_raw "ghc-internal Unit Id" -- LibDir is optional. If not set, derive it from topDir. This allows -- bindists to work without explicitly setting LibDir, but gives us the @@ -174,6 +176,8 @@ initSettings top_dir = do , sUnitSettings = UnitSettings { unitSettings_baseUnitId = stringToUnitId baseUnitId + , unitSettings_ghcUnitId = stringToUnitId ghcUnitId + , unitSettings_ghcInternalUnitId = stringToUnitId ghcInternalUnitId } , sToolSettings = ToolSettings ===================================== distrib/configure.ac.in ===================================== @@ -406,6 +406,12 @@ fi AC_SUBST(BaseUnitId) +dnl The units supplied with the target libraries, as reported by ghc --info. +GhcUnitId=@GhcUnitId@ +GhcInternalUnitId=@GhcInternalUnitId@ +AC_SUBST(GhcUnitId) +AC_SUBST(GhcInternalUnitId) + # We get caught by # http://savannah.gnu.org/bugs/index.php?1516 # $(eval ...) inside conditionals causes errors ===================================== hadrian/bindist/Makefile ===================================== @@ -90,6 +90,8 @@ lib/settings : config.mk @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ + @echo ',("Project Unit Id", "$(GhcUnitId)")' >> $@ + @echo ',("ghc-internal Unit Id", "$(GhcInternalUnitId)")' >> $@ @echo "]" >> $@ lib/targets/default.target : config.mk default.target ===================================== hadrian/bindist/config.mk.in ===================================== @@ -134,6 +134,8 @@ CrossCompilePrefix = @CrossCompilePrefix@ GhcUnregisterised = @Unregisterised@ EnableDistroToolchain = @EnableDistroToolchain@ BaseUnitId = @BaseUnitId@ +GhcUnitId = @GhcUnitId@ +GhcInternalUnitId = @GhcInternalUnitId@ # The THREADED_RTS requires `BaseReg` to be in a register and the # `GhcUnregisterised` mode doesn't allow that. ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -232,7 +232,7 @@ buildBinDistDir root conf@BindistConfig{..} = do let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" bindistContext = vanillaContext library_stage compiler bindistSettingsContent <- interpretInContext bindistContext $ - generateSettings bindistSettings False "package.conf.d" + generateSettings library_stage bindistSettings False "package.conf.d" writeFileAtomic bindistSettings bindistSettingsContent copyDirectory rtsIncludeDir bindistFilesDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -7,6 +7,7 @@ module Rules.Generate ( import Development.Shake.FilePath import qualified Data.Set as Set import Base +import BindistConfig import qualified Context import Expression import Hadrian.Oracles.TextFile (lookupStageBuildConfig) @@ -275,7 +276,7 @@ generateRules = do then root -/- stageString stage' -/- "lib" else prefix relPkgDb = makeRelativeNoSysLink libTopDir pkgDb - go (generateSettings out True relPkgDb) out + go (generateSettings libStage out True relPkgDb) out (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out where @@ -451,7 +452,9 @@ bindistRules = do , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ staged (fmap (isJust . tgtRTSWithLibdw) . targetStage) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors - , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base + , interpolateVar "BaseUnitId" $ bindistUnitId base + , interpolateVar "GhcUnitId" $ bindistUnitId compiler + , interpolateVar "GhcInternalUnitId" $ bindistUnitId ghcInternal , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP Stage2 , interpolateVar "TargetPlatformFull" (setting TargetPlatformFull) , interpolateVar "BuildPlatformFull" (setting BuildPlatformFull) @@ -460,6 +463,9 @@ bindistRules = do where interp = interpretInContext (semiEmptyTarget Stage2) getTarget = interp . queryTarget Stage2 + bindistUnitId pkg = do + stage <- library_stage <$> implicitBindistConfig + pkgUnitId stage pkg -- | Given a 'String' replace characters '.' and '-' by underscores ('_') so that -- the resulting 'String' is a valid C preprocessor identifier. @@ -485,18 +491,18 @@ ghcWrapper stage = do -- "package.conf.d"). Callers supply the correct relative path. For bindists -- the layout is known statically; for in-tree builds callers compute it. For -- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. -generateSettings :: FilePath -> Bool -> FilePath -> Expr String -generateSettings settingsFile includeLibDir rel_pkg_db = do +-- +-- @libraryStage@: the stage containing the target package database. +generateSettings :: Stage -> FilePath -> Bool -> FilePath -> Expr String +generateSettings libraryStage settingsFile includeLibDir rel_pkg_db = do ctx <- getContext stage <- getStage - -- The unit-id of the base package which is always linked against (#25382) - base_unit_id <- expr $ do - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> pkgUnitId Stage1 base - Stage2 -> pkgUnitId Stage1 base - Stage3 -> pkgUnitId Stage2 base + -- These are the units supplied in the target package database, which can + -- differ from the host units linked into a cross compiler. + base_unit_id <- expr $ pkgUnitId libraryStage base + ghc_unit_id <- expr $ pkgUnitId libraryStage compiler + ghc_internal_unit_id <- expr $ pkgUnitId libraryStage ghcInternal -- For cross compilers, LibDir points to the succeeding stage's lib dir -- (which contains the target architecture's libraries). For non-cross, @@ -519,6 +525,8 @@ generateSettings settingsFile includeLibDir rel_pkg_db = do , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) + , ("Project Unit Id", pure ghc_unit_id) + , ("ghc-internal Unit Id", pure ghc_internal_unit_id) ] ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir]) let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" @@ -555,7 +563,6 @@ generateConfigHs = do -- unit-id in both situations. cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage - cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -565,7 +572,6 @@ generateConfigHs = do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" - , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -589,9 +595,6 @@ generateConfigHs = do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId - , "" - , "cGhcInternalUnitId :: String" - , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] where stageString (Stage0 InTreeLibs) = "1" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/093abc716633d5decb638db44c2e10f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/093abc716633d5decb638db44c2e10f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0