Simon Peyton Jones pushed to branch wip/T27910 at Glasgow Haskell Compiler / GHC Commits: 336b87e2 by Simon Peyton Jones at 2026-10-13T14:17:27+01:00 Improve exprOkForSpeculation Fixes #27910, which exposed an infelicity in exprOkForSpeculation The new story is carefully described in new Note [exprOkForSpeculation], esp (a-c) and (EOKS1). - - - - - 4 changed files: - compiler/GHC/Core/Utils.hs - + testsuite/tests/simplCore/should_compile/T27910.hs - + testsuite/tests/simplCore/should_compile/T27910.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2260,7 +2260,8 @@ 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 | not (fun_ok fun) - = False -- This code path is only taken for Note [Speculative evaluation] + = False -- This code path is only taken for exprOkForSpecEval + -- See Note [Speculative evaluation] | idArity fun > n_val_args -- Partial application: just check passing the arguments is OK @@ -2323,30 +2324,35 @@ app_ok fun_ok primop_ok fun args where fun_ty = idType fun n_val_args = valArgCount args - (arg_tys, _) = splitPiTys fun_ty + (arg_tys, _) = splitPiTys fun_ty -- 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 -- A type argument - arg_ok (Anon ty _) arg -- A term argument - | definitelyLiftedType (scaledThing ty) - = True -- lifted args are not evaluated eagerly - | otherwise - = expr_ok fun_ok primop_ok arg + arg_ok (Named _) _ = True + arg_ok (Anon ty _) arg = exprIsCheap arg || definitelyLiftedType (scaledThing 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 - | NotMarkedStrict <- str -- iff it's a lazy field - , definitelyLiftedType (scaledThing ty) -- and its type is lifted - = True -- then the worker app does not eval - | otherwise - = expr_ok fun_ok primop_ok arg + = case typeLevity_maybe (scaledThing ty) of + Just Lifted -> str == NotMarkedStrict + Just Unlifted -> exprIsCheap arg + Nothing -> exprIsCheap arg && str == NotMarkedStrict + -- The Nothing case happens for + -- (#,#) @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. ----------------------------- altsAreExhaustive :: [Alt b] -> Bool @@ -2390,8 +2396,41 @@ cantEtaReduceFun fun -- Don't undersaturate StrictWorkerIds. -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info. -{- Note [exprOkForSpeculation and type classes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [exprOkForSpeculation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + data T a = K !a Int# a + +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 + +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 +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`. + +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. + +(EOKS1) To get the lifted-ness or otherwise of the arguments we just look at the + /uninstantiated/ type of the data constructor or primop. We'd get better information + if we instantiated, but it's also more expensive. Example: + (#,#) :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b -> (# a, b #) + 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. + + +Note [exprOkForSpeculation and type classes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider (#22745, #15205) \(d :: C a b). case eq_sel (sc_sel d) of ===================================== testsuite/tests/simplCore/should_compile/T27910.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE UnboxedTuples, MagicHash #-} +module T27910 where +import GHC.Exts + +k1 :: (# Int, Bool #) -> (# Int, Bool #) -> Int +{-# NOINLINE k1 #-} +k1 _ _ = 3 + +k2 :: (# Int#, Int# #) -> (# Int#, Int# #) -> Int +{-# NOINLINE k2 #-} +k2 _ _ = 3 + +lifted :: Int -> Bool -> Int +lifted x y = case (# x, y #) of r -> k1 r r + +unlifted :: Int# -> Int# -> Int +unlifted x y = case (# x, y #) of r -> k2 r r ===================================== testsuite/tests/simplCore/should_compile/T27910.stderr ===================================== @@ -0,0 +1,49 @@ + +==================== FloatOut stats: ==================== +2 Lets floated to top level; 0 Lets floated elsewhere; from 4 Lambda groups + + + +==================== FloatOut stats: ==================== +4 Lets floated to top level; 0 Lets floated elsewhere; from 6 Lambda groups + + + +==================== Grand total simplifier statistics ==================== +Total ticks: 30 + +8 PreInlineUnconditionally + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds +2 PostInlineUnconditionally + 1 r + 1 r +4 UnfoldingDone + 2 GHC.Internal.Prim.void# + 1 T27910.k1 + 1 T27910.k2 +8 BetaReduction + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds + 1 ds +4 KnownBranch + 2 wild + 1 ww + 1 ww +4 CaseElim + 2 ww + 2 ww +9 SimplifierDone 9 + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -627,3 +627,5 @@ test('T27749', compile, ['-O -g3 -ddump-simpl -dsuppress-uniques']) test('T27629', only_ways(['optasm']), makefile_test, ['T27629']) +test('T27910', grep_errmsg(r'KnownBranch'), compile, ['-O -dno-typeable-binds -ddump-simpl-stats -dsuppress-uniques']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/336b87e20e8df777c38eab5361ffc4cb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/336b87e20e8df777c38eab5361ffc4cb... 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