Simon Peyton Jones pushed to branch wip/T27724 at Glasgow Haskell Compiler / GHC Commits: 5b405cd7 by Simon Peyton Jones at 2026-09-10T17:08:46+01:00 Complete the noinline story - - - - - 12 changed files: - compiler/GHC/Builtin/WiredIn/Ids.hs - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Instance/Class.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - testsuite/tests/corelint/LintEtaExpand.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/WiredIn/Ids.hs ===================================== @@ -18,13 +18,16 @@ module GHC.Builtin.WiredIn.Ids ( wiredInIds, ghcPrimIds, realWorldPrimId, voidPrimId, voidArgId, - nullAddrId, seqId, lazyId, lazyIdKey, - coercionTokenId, coerceId, - proxyHashId, + nullAddrId, seqId, lazyId, lazyIdKey, proxyHashId, + coercionTokenId, coerceId, coerceName, nospecId, nospecIdName, - noinlineId, noinlineIdName, - noinlineConstraintId, noinlineConstraintIdName, - coerceName, leftSectionName, rightSectionName, + + getNoinlineId, isNoinlineId, + noinlineId, noinlineIdName, + noinlineConstraintId, noinlineConstraintIdName, + + leftSectionName, rightSectionName, + pcRepPolyId, unboxedUnitExpr, @@ -54,11 +57,14 @@ import GHC.Types.Name.Env import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.InlinePragma -import GHC.Types.Var (VarBndr(Bndr), visArgConstraintLike, tyVarName) +import GHC.Types.Var (VarBndr(Bndr), invisArgConstraintLike, tyVarName) +import GHC.Types.Basic( TypeOrConstraint(..) ) import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType +import GHC.Utils.Panic +import GHC.Utils.Outputable import GHC.Data.FastString @@ -92,7 +98,7 @@ that module's interface file; instead, the full definition is right here. Note [ghcPrimIds (aka pseudoops)] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The ghcPrimIds * Are exported from GHC.Prim (see ghcPrimExports, used in ghcPrimInterface) @@ -239,15 +245,15 @@ seqId = pcRepPolyId seqName ty concs info -- seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b ty = mkInfForAllTy runtimeRep2TyVar - $ mkSpecForAllTys [alphaTyVar, openBetaTyVar] - $ mkVisFunTyMany alphaTy (mkVisFunTyMany openBetaTy openBetaTy) + $ mkSpecForAllTys [alphaTyVar, rrPolyTyVar2] + $ mkVisFunTyMany alphaTy (mkVisFunTyMany rrPolyTy2 rrPolyTy2) - [x,y] = mkTemplateLocals [alphaTy, openBetaTy] - rhs = mkLams ([runtimeRep2TyVar, alphaTyVar, openBetaTyVar, x, y]) $ - Case (Var x) x openBetaTy [Alt DEFAULT [] (Var y)] + [x,y] = mkTemplateLocals [rrPolyTy1, rrPolyTy2] + rhs = mkLams ([runtimeRep2TyVar, alphaTyVar, rrPolyTyVar2, x, y]) $ + Case (Var x) x rrPolyTy2 [Alt DEFAULT [] (Var y)] concs = mkRepPolyIdConcreteTyVars - [ ((openBetaTy, mkArgPos 2 Top), runtimeRep2TyVar)] + [ ((rrPolyTy2, mkArgPos 2 Top), runtimeRep2TyVar)] arity = 2 @@ -271,15 +277,27 @@ noinlineId = pcMiscPrelId noinlineIdName ty info info = noCafIdInfo -- noinline :: forall r (a :: TYPE r). a -> a ty = mkInfForAllTy runtimeRep1TyVar $ - mkSpecForAllTys [openAlphaTyVar] $ - mkVisFunTyMany openAlphaTy openAlphaTy + mkSpecForAllTys [rrPolyTyVar1] $ + mkVisFunTyMany rrPolyTy1 rrPolyTy1 noinlineConstraintId :: Id -- See Note [noinlineId magic] noinlineConstraintId = pcMiscPrelId noinlineConstraintIdName ty info where info = noCafIdInfo - ty = mkSpecForAllTys [alphaConstraintTyVar] $ - mkFunTy visArgConstraintLike ManyTy alphaTy alphaConstraintTy + ty = mkInfForAllTy runtimeRep1TyVar $ + mkSpecForAllTys [rrPolyConstraintVar1] $ + mkFunTy invisArgConstraintLike ManyTy rrPolyConstraintTy1 rrPolyConstraintTy1 + +isNoinlineId :: Id -> Bool +isNoinlineId fn = key == noinlineIdKey || key == noinlineConstraintIdKey + where + key = getUnique fn + +getNoinlineId :: Type -> (Id, RuntimeRepType) +getNoinlineId ty = case sORTKind_maybe (typeKind ty) of + Just (TypeLike, rep) -> (noinlineId, rep) + Just (ConstraintLike, rep) -> (noinlineConstraintId, rep) + Nothing -> pprPanic "getNoinlineId" (ppr ty) ------------------------------------------------ nospecId :: Id -- See Note [nospecId magic] @@ -296,19 +314,19 @@ oneShotId = pcRepPolyId oneShotName ty concs info `setArityInfo` arity -- oneShot :: forall {r1 r2} (a :: TYPE r1) (b :: TYPE r2). (a -> b) -> (a -> b) ty = mkInfForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar ] $ - mkSpecForAllTys [ openAlphaTyVar, openBetaTyVar ] $ + mkSpecForAllTys [ rrPolyTyVar1, rrPolyTyVar2 ] $ mkVisFunTyMany fun_ty fun_ty - fun_ty = mkVisFunTyMany openAlphaTy openBetaTy - [body, x] = mkTemplateLocals [fun_ty, openAlphaTy] + fun_ty = mkVisFunTyMany rrPolyTy1 rrPolyTy2 + [body, x] = mkTemplateLocals [fun_ty, rrPolyTy1] x' = setOneShotLambda x -- Here is the magic bit! rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar - , openAlphaTyVar, openBetaTyVar + , rrPolyTyVar1, rrPolyTyVar2 , body, x'] $ Var body `App` Var x' arity = 2 concs = mkRepPolyIdConcreteTyVars - [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)] + [((rrPolyTy1, mkArgPos 2 Top), runtimeRep1TyVar)] ---------------------------------------------------------------------- {- Note [Wired-in Ids for rebindable syntax] @@ -340,20 +358,20 @@ leftSectionId = pcRepPolyId leftSectionName ty concs info `setUnfoldingInfo` mkCompulsoryUnfolding rhs `setArityInfo` arity ty = mkInfForAllTys [runtimeRep1TyVar,runtimeRep2TyVar, multiplicityTyVar1] $ - mkSpecForAllTys [openAlphaTyVar, openBetaTyVar] $ + mkSpecForAllTys [rrPolyTyVar1, rrPolyTyVar2] $ exprType body - [f,x] = mkTemplateLocals [mkVisFunTy mult openAlphaTy openBetaTy, openAlphaTy] + [f,x] = mkTemplateLocals [mkVisFunTy mult rrPolyTy1 rrPolyTy2, rrPolyTy1] mult = mkTyVarTy multiplicityTyVar1 :: Mult xmult = setIdMult x mult rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar, multiplicityTyVar1 - , openAlphaTyVar, openBetaTyVar ] body + , rrPolyTyVar1, rrPolyTyVar2 ] body body = mkLams [f,xmult] $ App (Var f) (Var xmult) arity = 2 concs = mkRepPolyIdConcreteTyVars - [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)] + [((rrPolyTy1, mkArgPos 2 Top), runtimeRep1TyVar)] -- See Note [Left and right sections] in GHC.Rename.Expr -- See Note [Wired-in Ids for rebindable syntax] @@ -369,26 +387,26 @@ rightSectionId = pcRepPolyId rightSectionName ty concs info `setArityInfo` arity ty = mkInfForAllTys [runtimeRep1TyVar,runtimeRep2TyVar,runtimeRep3TyVar , multiplicityTyVar1, multiplicityTyVar2 ] $ - mkSpecForAllTys [openAlphaTyVar, openBetaTyVar, openGammaTyVar ] $ + mkSpecForAllTys [rrPolyTyVar1, rrPolyTyVar2, rrPolyTyVar3] $ exprType body mult1 = mkTyVarTy multiplicityTyVar1 mult2 = mkTyVarTy multiplicityTyVar2 - [f,x,y] = mkTemplateLocals [ mkScaledFunTys [ Scaled mult1 openAlphaTy - , Scaled mult2 openBetaTy ] openGammaTy - , openAlphaTy, openBetaTy ] + [f,x,y] = mkTemplateLocals [ mkScaledFunTys [ Scaled mult1 rrPolyTy1 + , Scaled mult2 rrPolyTy2 ] rrPolyTy3 + , rrPolyTy1, rrPolyTy2 ] xmult = setIdMult x mult1 ymult = setIdMult y mult2 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar , multiplicityTyVar1, multiplicityTyVar2 - , openAlphaTyVar, openBetaTyVar, openGammaTyVar ] body + , rrPolyTyVar1, rrPolyTyVar2, rrPolyTyVar3 ] body body = mkLams [f,ymult,xmult] $ mkVarApps (Var f) [xmult,ymult] arity = 3 concs = mkRepPolyIdConcreteTyVars - [ ((openAlphaTy, mkArgPos 3 Top), runtimeRep1TyVar) - , ((openBetaTy , mkArgPos 2 Top), runtimeRep2TyVar)] + [ ((rrPolyTy1, mkArgPos 3 Top), runtimeRep1TyVar) + , ((rrPolyTy2, mkArgPos 2 Top), runtimeRep2TyVar)] -------------------------------------------------------------------------------- @@ -521,55 +539,55 @@ Implementing 'lazy' is a bit tricky: Note [noinlineId magic] ~~~~~~~~~~~~~~~~~~~~~~~ -'noinline' is used to make sure that a function f is never inlined, -e.g., as in 'noinline f x'. We won't inline f because we never inline -lone variables (see Note [Lone variables] in GHC.Core.Unfold +'noinline' is used to make sure that a function f is never inlined, e.g + noinline f x + noinline (f x) +Both of these will work. Here are the moving parts: -You might think that we could implement noinline like this: - {-# NOINLINE #-} - noinline :: forall a. a -> a - noinline x = x +* `noinline` is magic Id (see Note [magicIds]), whose wired-in behaviour is + defined in this module, GHC.Builtin.WiredIn.Ids. -But actually we give 'noinline' a wired-in name for three distinct reasons: +* In the Simplifier, see the `isNoInlineId` case of `simplOutId`. + When we encounter noinline (f e1 e2) e3 e4: + * We switch off inlining before simplifying `f` (#18995) + * We slide `e3` and `e4` under the `noinline` to give + noinline (f e1 e2 e3 e4) + See wrinkle (NOI1) -1. We don't want to leave a (useless) call to noinline in the final program, - to be executed at runtime. So we have a little bit of magic to - optimize away 'noinline' after we are done running the simplifier. - This is done in GHC.CoreToStg.Prep.cpeApp. - -2. 'noinline' sometimes gets inserted automatically when we serialize an - expression to the interface format, in GHC.CoreToIface.toIfaceVar. - See Note [Inlining and hs-boot files] in GHC.CoreToIface - -3. Given foo :: Eq a => [a] -> Bool, the expression - noinline foo x xs - where x::Int, will naturally desugar to - noinline @Int (foo @Int dEqInt) x xs - But now it's entirely possible that (foo @Int dEqInt) will inline foo, - since 'foo' is no longer a lone variable -- see #18995 - - Solution: in the desugarer, rewrite - noinline (f x y) ==> noinline f x y - This is done in the `noinlineId` case of `GHC.HsToCore.Expr.ds_app_var` - This is only needed for noinlineId, not noInlineConstraintId (wrinkle - (W1) below), because the latter never shows up in user code. +* In GHC.CoreToStg.Prep.cpe_app, we discard the `noinline`, so that + there is no runtime overhead. Wrinkles -(W1) Sometimes case (2) above needs to apply `noinline` to a type of kind +(NOI1) It's very important to have + noinline (f e1 e2) -- `f` visibly applied + and NOT + noinline f e1 e2 -- `f` is not applied + Because we want + * Strictness (#18396, #23911, #16588) + * Type-class specialisation (#27724) + * Rewrite rules + all to work, and they won't if `f` isn't applied to anything + +(NOI2) `noinline` needs to apply to unboxed types, so that + noinline (f x y) + works even if `f` happens to return Int#. So + noinline :: forall (r::RuntimeRep) (a::TYPE r). a -> a + +(NOI3) Very trickily, 'noinline' sometimes gets inserted automatically when we + serialize an expression to the interface format, in `GHC.CoreToIface.toIfaceVar`. + See Note [Inlining and hs-boot files] in GHC.CoreToIface + +(NOI4) Sometimes case (NOI3) needs to apply `noinline` to a type of kind Constraint; e.g. noinline @(Eq Int) $dfEqInt - We don't have type-or-kind polymorphism, so we simply have two `inline` - Ids, namely `noinlineId` and `noinlineConstraintId`. - -(W2) Note that noinline as currently implemented can hide some simplifications - since it hides strictness from the demand analyser. Specifically, the - demand analyser will treat 'noinline f x' as lazy in 'x', even if the - demand signature of 'f' specifies that it is strict in its argument. We - considered fixing this this by adding a special case to the demand - analyser to address #16588. However, the special case seemed like a large - and expensive hammer to address a rare case and consequently we rather - opted to use a more minimal solution. + We don't have type-or-constraint polymorphism, so we simply have two + `inline` Ids, namely `noinlineId` and `noinlineConstraintId`: + + noinline :: forall (r::RuntimeRep) (a::TYPE r). a -> a + noinlineConstraint :: forall (r::RuntimeRep) (a::CONSTRAINT r). a => a + + Tiresome but simple. Note [nospecId magic] ~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Builtin/WiredIn/Prim.hs ===================================== @@ -32,10 +32,13 @@ module GHC.Builtin.WiredIn.Prim( alphaConstraintTyVar, alphaConstraintTy, - openAlphaTyVar, openBetaTyVar, openGammaTyVar, - openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec, - openAlphaTy, openBetaTy, openGammaTy, + -- Runtime-rep-polymorphic tyvars, of kind (TYPE rr) + rrPolyTyVar1, rrPolyTyVar2, rrPolyTyVar3, + rrPolyTy1, rrPolyTy2, rrPolyTy3, + rrPolyTyVarSpec1, rrPolyTyVarSpec2, rrPolyTyVarSpec3, + rrPolyConstraintVar1, rrPolyConstraintTy1, + -- Levity-polymorphic tyvars levPolyAlphaTyVar, levPolyBetaTyVar, levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec, levPolyAlphaTy, levPolyBetaTy, @@ -503,24 +506,29 @@ runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: RuntimeRepType runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar runtimeRep3Ty = mkTyVarTy runtimeRep3TyVar -openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar --- alpha :: TYPE r1 --- beta :: TYPE r2 --- gamma :: TYPE r3 -[openAlphaTyVar,openBetaTyVar,openGammaTyVar] + +rrPolyTyVar1, rrPolyTyVar2, rrPolyTyVar3, rrPolyConstraintVar1 :: TyVar +-- rrPolyTyVar1 :: TYPE r1 +-- rrPolyTyVar2 :: TYPE r2 +-- rrPolyTyVar2 :: TYPE r3 +-- rrPolyConstraintVar1 :: CONSTRAINT r1 +-- All have distinct uniques +[ rrPolyTyVar1, rrPolyTyVar2, rrPolyTyVar3, rrPolyConstraintVar1 ] = mkTemplateTyVars [ mk_TYPE_app runtimeRep1Ty , mk_TYPE_app runtimeRep2Ty - , mk_TYPE_app runtimeRep3Ty] - -openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder -openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar -openBetaTyVarSpec = mkTyVarBinder Specified openBetaTyVar -openGammaTyVarSpec = mkTyVarBinder Specified openGammaTyVar - -openAlphaTy, openBetaTy, openGammaTy :: Type -openAlphaTy = mkTyVarTy openAlphaTyVar -openBetaTy = mkTyVarTy openBetaTyVar -openGammaTy = mkTyVarTy openGammaTyVar + , mk_TYPE_app runtimeRep3Ty + , mk_CONSTRAINT_app runtimeRep1Ty ] + +rrPolyTyVarSpec1, rrPolyTyVarSpec2, rrPolyTyVarSpec3 :: TyVarBinder +rrPolyTyVarSpec1 = mkTyVarBinder Specified rrPolyTyVar1 +rrPolyTyVarSpec2 = mkTyVarBinder Specified rrPolyTyVar2 +rrPolyTyVarSpec3 = mkTyVarBinder Specified rrPolyTyVar3 + +rrPolyTy1, rrPolyTy2, rrPolyTy3, rrPolyConstraintTy1 :: Type +rrPolyTy1 = mkTyVarTy rrPolyTyVar1 +rrPolyTy2 = mkTyVarTy rrPolyTyVar2 +rrPolyTy3 = mkTyVarTy rrPolyTyVar3 +rrPolyConstraintTy1 = mkTyVarTy rrPolyConstraintVar1 levity1TyVar, levity2TyVar :: TyVar (levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -60,8 +60,8 @@ import GHC.Types.Tickish import GHC.Types.Var ( isTyCoVar ) import GHC.Builtin.WiredIn.Prim( realWorldStatePrimTy ) -import GHC.Builtin.KnownKeys( runRWKey, seqHashKey, noinlineIdKey ) -import GHC.Builtin.WiredIn.Ids( seqId ) +import GHC.Builtin.KnownKeys( runRWKey, seqHashKey ) +import GHC.Builtin.WiredIn.Ids( seqId, getNoinlineId, isNoinlineId ) import qualified GHC.Data.List.Infinite as Inf import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) @@ -2369,8 +2369,8 @@ simplOutId env fun cont call' = mkApps (Var fun) [mkTyArg rr', mkTyArg new_runrw_res_ty, arg'] ; rebuild_go env call' outer_cont } -simplOutId env inline_fun cont - | inline_fun `hasKey` noinlineIdKey +simplOutId env noinline_fun cont + | isNoinlineId noinline_fun , ApplyToTy { sc_cont = cont1 } <- cont , ApplyToTy { sc_cont = cont2 } <- cont1 , ApplyToVal { sc_cont = cont3, sc_arg = the_call, sc_cast = arg_mco @@ -2386,10 +2386,12 @@ simplOutId env inline_fun cont ; let call_env = updMode updModeForNoInline $ arg_se `setInScopeFromE` env ; (floats1, call') <- simplExprF call_env inner_fun call_cont - ; let new_call_ty = contHoleType rest_cont - noinline_expr = Var inline_fun `App` Type (getRuntimeRep new_call_ty) - `App` Type new_call_ty - `App` mkCastMCo call' arg_mco + ; let new_call_ty = contHoleType rest_cont + (new_noinline_fun, rep) = getNoinlineId new_call_ty + noinline_expr = Var new_noinline_fun + `App` Type rep + `App` Type new_call_ty + `App` mkCastMCo call' arg_mco ; (floats2, res) <- rebuild env noinline_expr rest_cont ; return (floats2 `addFloats` floats1 , res) } ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -114,7 +114,8 @@ type KindOrType = Type -- See Note [Arguments to type constructors] -- | The key type representing kinds in the compiler. type Kind = Type --- | Type synonym used for types of kind RuntimeRep. +-- | Type synonym used for Types of kind RuntimeRep. +-- E.g. The type IntRep :: RuntimeRep type RuntimeRepType = Type -- | Type synonym used for types of kind Levity. ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2686,7 +2686,7 @@ typeKind ty@(ForAllTy {}) --------------------------------------------- -sORTKind_maybe :: Kind -> Maybe (TypeOrConstraint, Type) +sORTKind_maybe :: Kind -> Maybe (TypeOrConstraint, RuntimeRepType) -- Sees if the argument is of form (TYPE rep) or (CONSTRAINT rep) -- and if so returns which, and the runtime rep -- ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -63,7 +63,7 @@ import GHC.Core.TyCo.Tidy import GHC.Builtin.WiredIn.Prim ( eqPrimTyCon, eqReprPrimTyCon ) import GHC.Builtin.WiredIn.Types ( heqTyCon ) -import GHC.Builtin.WiredIn.Ids ( noinlineIdName ) +import GHC.Builtin.WiredIn.Ids ( getNoinlineId ) import GHC.Iface.Syntax import GHC.Data.FastString @@ -658,9 +658,9 @@ toIfaceVar :: Id -> IfaceExpr toIfaceVar v | isBootUnfolding (idUnfolding v) = -- See Note [Inlining and hs-boot files] - IfaceExt noinlineIdName `IfaceApp` - IfaceType (toIfaceType rep) `IfaceApp` - IfaceType (toIfaceType ty) `IfaceApp` + IfaceExt (idName noinline_id) `IfaceApp` + IfaceType (toIfaceType rep) `IfaceApp` + IfaceType (toIfaceType ty) `IfaceApp` IfaceExt name -- Don't use mkIfaceApps, or infinite loop | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) @@ -671,7 +671,7 @@ toIfaceVar v where name = idName v ty = idType v - rep = getRuntimeRep ty + (noinline_id, rep) = getNoinlineId ty --------------------- toIfaceLFInfo :: Name -> LambdaFormInfo -> IfaceLFInfo @@ -750,7 +750,7 @@ But how do we arrange for this to happen? There are two ingredients: 1. When we serialize out unfoldings to IfaceExprs (toIfaceVar), for every variable reference we see if we are referring to an 'Id' that came from an hs-boot file. If so, we add a `noinline` - to the reference. See Note [noinlineId magic] + to the reference. See Note [noinlineId magic] esp (NOI3) in GHC.Types.Id.Make 2. But how do we know if a reference came from an hs-boot file ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Builtin.PrimOps import GHC.Builtin.PrimOps.Ids import GHC.Builtin.WiredIn.Types import GHC.Builtin.WiredIn.Prim -import GHC.Builtin.WiredIn.Ids ( realWorldPrimId ) +import GHC.Builtin.WiredIn.Ids ( realWorldPrimId, isNoinlineId ) import GHC.Core.Utils import GHC.Core.Opt.Arity @@ -1274,7 +1274,7 @@ eliminateMagicCall f (AIApp Type{} : AIApp arg : args) -- See Note [nospecId magic] in GHC.Types.Id.Make eliminateMagicCall f (AIApp Type{} : AIApp Type{} : AIApp arg : args) - | f `hasKey` noinlineIdKey = Just (arg,args) + | isNoinlineId f = Just (arg,args) -- Replace (noinline a) with a -- See Note [noinlineId magic] in GHC.Types.Id.Make ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -706,8 +706,10 @@ patchMagicDefn orig_pair@(orig_id, orig_rhs) = do { magic_pair@(magic_id, _) <- mk_magic_pair orig_id orig_rhs -- Patching should not change the Name or the type of the Id - ; massert (getUnique magic_id == getUnique orig_id) - ; massert (varType magic_id `eqType` varType orig_id) + ; massertPpr (getUnique magic_id == getUnique orig_id) (ppr orig_id) + ; massertPpr (varType magic_id `eqType` varType orig_id) $ + vcat [ text "orig_id:" <+> ppr orig_id <+> dcolon <+> ppr (varType orig_id) + , text "magic_id:" <+> ppr magic_id <+> dcolon <+> ppr (varType magic_id) ] ; return magic_pair } | otherwise @@ -752,7 +754,7 @@ mkUnsafeCoercePrimPair _old_id old_expr ; let [unsafe_refl_data_con] = tyConDataCons unsafe_equality_tc rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar - , openAlphaTyVar, openBetaTyVar + , rrPolyTyVar1, rrPolyTyVar2 , x ] $ mkSingleAltCase scrut1 (mkWildValBinder ManyTy scrut1_ty) @@ -765,7 +767,7 @@ mkUnsafeCoercePrimPair _old_id old_expr Var x `mkCast` x_co [x, rr_cv, ab_cv] = mkTemplateLocals - [ openAlphaTy -- x :: a + [ rrPolyTy1 -- x :: a , rr_cv_ty -- rr_cv :: r1 ~# r2 , ab_cv_ty -- ab_cv :: (alpha |> alpha_co ~# beta) ] @@ -783,15 +785,15 @@ mkUnsafeCoercePrimPair _old_id old_expr runtimeRep1Ty runtimeRep2Ty (scrut2, scrut2_ty, ab_cv_ty) = unsafe_equality (mkTYPEapp runtimeRep2Ty) - (openAlphaTy `mkCastTy` alpha_co) - openBetaTy + (rrPolyTy1 `mkCastTy` alpha_co) + rrPolyTy2 -- alpha_co :: TYPE r1 ~# TYPE r2 -- alpha_co = TYPE rr_cv alpha_co = mkTyConAppCo Nominal tYPETyCon [mkCoVarCo rr_cv] -- x_co :: alpha ~R# beta - x_co = mkGReflMCo Representational openAlphaTy alpha_co `mkTransCo` + x_co = mkGReflMCo Representational rrPolyTy1 alpha_co `mkTransCo` mkSubCo (mkCoVarCo ab_cv) @@ -800,13 +802,13 @@ mkUnsafeCoercePrimPair _old_id old_expr `setArityInfo` arity ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar - , openAlphaTyVar, openBetaTyVar ] $ - mkVisFunTyMany openAlphaTy openBetaTy + , rrPolyTyVar1, rrPolyTyVar2 ] $ + mkVisFunTyMany rrPolyTy1 rrPolyTy2 arity = 1 concs = mkRepPolyIdConcreteTyVars - [((mkTyVarTy openAlphaTyVar, mkArgPos 1 Top), runtimeRep1TyVar)] + [((rrPolyTy1, mkArgPos 1 Top), runtimeRep1TyVar)] unsafeCoercePrimName id = mkExportedLocalId (RepPolyId concs) unsafeCoercePrimName ty `setIdInfo` info ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -443,7 +443,7 @@ matchWithDict [cls_ty, mty] , Just (cls, dict_dc) <- isUnaryClassTyCon_maybe dict_tc , [inst_meth_ty] <- dataConInstArgTys dict_dc dict_args = do { sv <- mkSysLocalM (fsLit "withDict_s") ManyTy mty - ; k <- mkSysLocalM (fsLit "withDict_k") ManyTy (mkInvisFunTy cls_ty openAlphaTy) + ; k <- mkSysLocalM (fsLit "withDict_k") ManyTy (mkInvisFunTy cls_ty rrPolyTy1) ; wd_cls <- tcLookupKnownKeyClass withDictClassKey -- Given ev_expr : mty ~N# inst_meth_ty, construct the method of @@ -452,7 +452,7 @@ matchWithDict [cls_ty, mty] -- \@(r :: RuntimeRep) @(a :: TYPE r) (sv :: mty) (k :: cls => a) -> -- k (MkC tys (sv |> sub co2)) ; let evWithDict ev_expr - = mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $ + = mkCoreLams [ runtimeRep1TyVar, rrPolyTyVar1, sv, k ] $ Var k `App` (evUnaryDictAppE cls dict_args meth_arg) where meth_arg = Var sv `mkCast` mkSubCo (evExprCoercion ev_expr) ===================================== libraries/ghc-internal/src/GHC/Internal/Magic.hs ===================================== @@ -62,9 +62,14 @@ inline x = x -- | The call @noinline f@ arranges that @f@ will not be inlined. -- It is removed during CorePrep so that its use imposes no overhead -- (besides the fact that it blocks inlining.) -noinline :: a -> a -{-# NOINLINE noinline #-} -- noinline is inlined manually in CorePrep -noinline x = x +noinline :: forall (r :: RuntimeRep) (a :: TYPE r). + a -> a +{-# NOINLINE noinline #-} +-- See Note [noinlineId magic] in GHC.Builtin.WiredIn.Ids +noinline = noinline -- Never called, eliminated in CorePrep + -- We can't conveniently call `error` here because + -- GHC.Internal.Err depends on GHC.Internal.Magic.noinline! + -- Hence this silly loop. -- | The 'lazy' function restrains strictness analysis a little. The -- call @lazy e@ means the same as @e@, but 'lazy' has a magical ===================================== testsuite/tests/corelint/LintEtaExpand.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Builtin.PrimOps.Ids ( primOpId ) import GHC.Builtin.WiredIn.Prim ( runtimeRep1Ty, runtimeRep1TyVar - , openAlphaTy, openAlphaTyVar + , rrPolyTyVar1, rrPolyTy1 ) import GHC.Core @@ -79,7 +79,7 @@ test_exprs = [ Type liftedDataConTy , Type liftedRepTy , Type intTy - , Type $ mkVisFunTyMany openAlphaTy openAlphaTy + , Type $ mkVisFunTyMany rrPolyTy1 rrPolyTy1 ] , ("raise# OK 2", ) $ -- raise# @Lifted @r @@ -107,7 +107,7 @@ test_exprs = -- These will be considered in-scope by the Core Lint checks. in_scope :: [ Id ] -in_scope = [ runtimeRep1TyVar, openAlphaTyVar ] +in_scope = [ runtimeRep1TyVar, rrPolyTyVar1 ] main :: IO () main = do ===================================== utils/genprimopcode/Main.hs ===================================== @@ -751,15 +751,16 @@ ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec" ppTyVar "b" = nonDepTyVarBinder "betaTyVarSpec" ppTyVar "c" = nonDepTyVarBinder "gammaTyVarSpec" ppTyVar "s" = nonDepTyVarBinder "deltaTyVarSpec" + -- See Note [Levity and representation polymorphic primops] in primops.txt.pp ppTyVar "a_reppoly" = PrimOpTyVarBinder { inferredTyVarBinders = ["runtimeRep1TyVarInf"] - , primOpTyVarBinder = "openAlphaTyVarSpec" } + , primOpTyVarBinder = "rrPolyTyVarSpec1" } ppTyVar "b_reppoly" = PrimOpTyVarBinder { inferredTyVarBinders = ["runtimeRep2TyVarInf"] - , primOpTyVarBinder = "openBetaTyVarSpec" } + , primOpTyVarBinder = "rrPolyTyVarSpec2" } ppTyVar "a_levpoly" = PrimOpTyVarBinder { inferredTyVarBinders = ["levity1TyVarInf"] @@ -802,8 +803,8 @@ ppType (TyVar "b") = "betaTy" ppType (TyVar "c") = "gammaTy" ppType (TyVar "s") = "deltaTy" -- See Note [Levity and representation polymorphic primops] in primops.txt.pp -ppType (TyVar "a_reppoly") = "openAlphaTy" -ppType (TyVar "b_reppoly") = "openBetaTy" +ppType (TyVar "a_reppoly") = "rrPolyTy1" +ppType (TyVar "b_reppoly") = "rrPolyTy2" ppType (TyVar "a_levpoly") = "levPolyAlphaTy" ppType (TyVar "b_levpoly") = "levPolyBetaTy" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b405cd7ed126c62a9568e3682e93a4b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b405cd7ed126c62a9568e3682e93a4b... 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