Simon Peyton Jones pushed to branch wip/T27910 at Glasgow Haskell Compiler / GHC Commits: 90f4a34f by Simon Peyton Jones at 2026-10-14T10:08:11+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -490,7 +490,7 @@ This is a well-kinded type, in an environment-based scheme. But `typeKind` will panic, because the kind of the body of a forall must not mention the forall'd variable (and the inner forall's body appears to do so). -It might be possible to make `exprType` and `typeKind`` more complicated, so that +It might be possible to make `exprType` and `typeKind` more complicated, so that they do renaming on the fly. But instead we impose INVARIANT (NoTypeShadowing): ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2207,6 +2207,8 @@ fun_always_ok _ = True -- | A special version of 'exprOkForSpeculation' used during -- Note [Speculative evaluation]. When the predicate arg `fun_ok` returns False -- for `b`, then `b` is never considered ok-for-spec. +-- +-- This is the whole reason for the fun_ok arg to expr_ok. exprOkForSpecEval :: (Id -> Bool) -> CoreExpr -> Bool exprOkForSpecEval fun_ok = expr_ok fun_ok primOpOkForSpeculation @@ -2258,7 +2260,7 @@ expr_ok fun_ok primop_ok other_expr ----------------------------- app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool -app_ok fun_ok primop_ok fun args +app_ok fun_ok primop_ok fun val_args | not (fun_ok fun) = False -- This code path is only taken for exprOkForSpecEval -- See Note [Speculative evaluation] @@ -2282,17 +2284,18 @@ app_ok fun_ok primop_ok fun args ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] - -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ + -> assertPpr (n_val_args == 1) (ppr fun $$ ppr val_args) $ True -- assert: terminating result type => can't be applied; -- c.f the _other case below PrimOpId op _ | primOpIsDiv op - , Lit divisor <- last args + , Lit divisor <- last val_args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (init args) + -> not (isZeroLit divisor) && + all ok_for_spec (init val_args) -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK @@ -2301,12 +2304,14 @@ app_ok fun_ok primop_ok fun args -- can get rid of a thunk in an inner loop | otherwise -> primop_ok op && args_ok + -- Assumes that the primop does not evaluate its + -- definitely-lifted arguments _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF | isTerminatingType fun_ty -- See Note [exprOkForSpeculation and type classes] || definitelyUnliftedType fun_ty - -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr val_args) True -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#) -- are non-functions and so will have no value args. The assert is -- just to check this. @@ -2322,37 +2327,40 @@ app_ok fun_ok primop_ok fun args -- for evaluated-ness of the fun; -- see Note [exprOkForSpeculation and evaluated variables] where - fun_ty = idType fun - n_val_args = valArgCount args - (arg_tys, _) = splitPiTys fun_ty -- arg_tys are /uninstantiated/ - -- See (EOKS1) + ok_for_spec = expr_ok fun_ok primop_ok -- Used for recursive calls + + fun_ty = idType fun + n_val_args = length val_args + val_arg_tys = uninstantiatedValArgTys fun_ty + -- val_arg_tys are /uninstantiated/; see (EOKS1) -- Even if a function call itself is OK, any unlifted -- args are still evaluated eagerly and must be checked -- arg_ok bndr arg = field_ok bndr NotMarkedStrict arg -- See Note [exprOkForSpeculation] (a-c) - args_ok = all2Prefix arg_ok arg_tys args - arg_ok :: PiTyVarBinder -> CoreExpr -> Bool - arg_ok (Named _) _ = True - arg_ok (Anon ty _) arg = exprIsCheap arg || definitelyLiftedType (scaledThing ty) + args_ok = all2Prefix arg_ok val_arg_tys val_args + arg_ok :: Type -> CoreExpr -> Bool + arg_ok arg_ty arg = ok_for_spec arg || definitelyLiftedType arg_ty -- Used for strict DataCon worker arguments -- See (SFC1) of Note [Strict fields in Core] -- See Note [exprOkForSpeculation] (a-c) - fields_ok str_marks = all3Prefix field_ok arg_tys str_marks args - field_ok :: PiTyVarBinder -> StrictnessMark -> CoreExpr -> Bool - field_ok (Named _) _ _ = True - field_ok (Anon ty _) str arg - = case typeLevity_maybe (scaledThing ty) of + fields_ok str_marks = all3Prefix field_ok val_arg_tys str_marks val_args + field_ok :: Type -> StrictnessMark -> CoreExpr -> Bool + field_ok arg_ty str arg + = case typeLevity_maybe arg_ty of Just Lifted -> str == NotMarkedStrict - Just Unlifted -> exprIsCheap arg - Nothing -> exprIsCheap arg && str == NotMarkedStrict - -- The Nothing case happens for + Just Unlifted -> ok_for_spec arg + Nothing | str == NotMarkedStrict + , definitelyLiftedType (exprType arg) + -> True + | otherwise + -> ok_for_spec arg + -- The Nothing case: consider -- (#,#) @rep1 @rep2 @ty1 @ty2 arg1 arg2 -- We don't /instantiate/ the type (though we could) so we don't know - -- if lifted or not, so we conservatively check both conditions. This - -- gives a conservative answer False for (# null xs, null ys #), but - -- these unboxed tuples are usually ANF'd so it doesn't reallly matter. + -- if the argument type is lifted or not. So we look at the type of + -- the /actual/ argument (it's usually a variable) instead. ----------------------------- altsAreExhaustive :: [Alt b] -> Bool @@ -2405,8 +2413,8 @@ Is the call (K e1 e2 e3) ok-for-speculation? Lok at the arguments e1..e3, and their types. The call is ok-for-speculation if each argument satisfies `field_ok`, namely: (a) Arg type is definitely lifted => arg is not marked strict - (b) Arg type is definitely unlifted => (exprIsCheap arg) is True - (c) Otherwise => not marked strict && exprIsCheap + (b) Arg type is definitely unlifted => (exprOkForSpeculation arg) is True + (c) Otherwise => not marked strict && exprOkForSpeculation For (a), an arbitrary /lazy/ argument is ok provided we don't have a bang. For a strict argument you might wonder if we could use exprIsHNF, but see @@ -2414,7 +2422,7 @@ Note [exprOkForSpeculation and evaluated variables]. So for strict arguments we just say "no". For (b) a variable, or casted variable is fine. But not a call, say (f x). -Hence `exprisCheap`. +Hence `exprOkForSpeculation`. For (c) we don't know if we are in case (a) or (b) so we conservatively 'and' them. See (EOKS1) for how we can get this situation. @@ -2426,8 +2434,8 @@ them. See (EOKS1) for how we can get this situation. If we have a call (#,#) @LiftedRep @IntRep @Int @Int# 3 4# then we could see accurate liftedness by instantiation, but we don't try. - Typically the argument is a variable, in which case `exprIsCheap` does a good job. - + Instead we get the actual type from (exprType arg). That could be expensive, + but it really only happens for unboxed tuples. Note [exprOkForSpeculation and type classes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2713,8 +2721,7 @@ exprIsHNFlike is_con is_con_unf rubbish_lit_result e -- PAP: Check unlifted val_args args_hnf = all2Prefix check_arg val_arg_tys val_args - fun_ty = idType id - val_arg_tys = mapMaybe anonPiTyBinderType_maybe (collectPiTyBinders fun_ty) + val_arg_tys = uninstantiatedValArgTys (idType id) -- val_arg_tys = map exprType val_args, but much less costly. -- The obvious definition regresses T16577 by 30% so we don't do it. @@ -2739,6 +2746,12 @@ exprIsHNFlike is_con is_con_unf rubbish_lit_result e | otherwise = Nothing +uninstantiatedValArgTys :: Type -> [Type] +-- Returns the value argument types. +-- E.g. uninstantiatedValArgTys (forall a. a -> Int -> T a) +-- returns [a, Int] +uninstantiatedValArgTys fun_ty + = [ scaledThing ty | Anon ty _ <- collectPiTyBinders fun_ty ] {- Note [exprIsHNF Tick] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90f4a34f42139dec0e72792d54997731... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90f4a34f42139dec0e72792d54997731... 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