Simon Peyton Jones pushed to branch wip/T27910 at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -2260,7 +2260,8 @@ expr_ok fun_ok primop_ok other_expr
    2260 2260 
     app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool
    2261 2261 
     app_ok fun_ok primop_ok fun args
    2262 2262 
       | not (fun_ok fun)
    2263 
    -  = False -- This code path is only taken for Note [Speculative evaluation]
    2263 
    +  = False -- This code path is only taken for exprOkForSpecEval
    2264 
    +          -- See Note [Speculative evaluation]
    2264 2265
    2265 2266 
       | idArity fun > n_val_args
    2266 2267 
       -- Partial application: just check passing the arguments is OK
    ... ... @@ -2323,30 +2324,35 @@ app_ok fun_ok primop_ok fun args
    2323 2324 
       where
    2324 2325 
         fun_ty       = idType fun
    2325 2326 
         n_val_args   = valArgCount args
    2326 
    -    (arg_tys, _) = splitPiTys fun_ty
    2327 
    +    (arg_tys, _) = splitPiTys fun_ty  -- arg_tys are /uninstantiated/
    2328 
    +                                      -- See (EOKS1)
    2327 2329
    2328 2330 
         -- Even if a function call itself is OK, any unlifted
    2329 2331 
         -- args are still evaluated eagerly and must be checked
    2332 
    +    --   arg_ok bndr arg = field_ok bndr NotMarkedStrict arg
    2333 
    +    -- See Note [exprOkForSpeculation] (a-c)
    2330 2334 
         args_ok = all2Prefix arg_ok arg_tys args
    2331 2335 
         arg_ok :: PiTyVarBinder -> CoreExpr -> Bool
    2332 
    -    arg_ok (Named _) _ = True   -- A type argument
    2333 
    -    arg_ok (Anon ty _) arg      -- A term argument
    2334 
    -       | definitelyLiftedType (scaledThing ty)
    2335 
    -       = True -- lifted args are not evaluated eagerly
    2336 
    -       | otherwise
    2337 
    -       = expr_ok fun_ok primop_ok arg
    2336 
    +    arg_ok (Named _)  _    = True
    2337 
    +    arg_ok (Anon ty _) arg = exprIsCheap arg || definitelyLiftedType (scaledThing ty)
    2338 2338
    2339 2339 
         -- Used for strict DataCon worker arguments
    2340 2340 
         -- See (SFC1) of Note [Strict fields in Core]
    2341 
    +    -- See Note [exprOkForSpeculation] (a-c)
    2341 2342 
         fields_ok str_marks = all3Prefix field_ok arg_tys str_marks args
    2342 2343 
         field_ok :: PiTyVarBinder -> StrictnessMark -> CoreExpr -> Bool
    2343 2344 
         field_ok (Named _)   _   _ = True
    2344 2345 
         field_ok (Anon ty _) str arg
    2345 
    -       | NotMarkedStrict <- str                 -- iff it's a lazy field
    2346 
    -       , definitelyLiftedType (scaledThing ty)  -- and its type is lifted
    2347 
    -       = True                                   -- then the worker app does not eval
    2348 
    -       | otherwise
    2349 
    -       = expr_ok fun_ok primop_ok arg
    2346 
    +       = case typeLevity_maybe (scaledThing ty) of
    2347 
    +           Just Lifted   -> str == NotMarkedStrict
    2348 
    +           Just Unlifted -> exprIsCheap arg
    2349 
    +           Nothing       -> exprIsCheap arg && str == NotMarkedStrict
    2350 
    +           -- The Nothing case happens for
    2351 
    +           --     (#,#) @rep1 @rep2 @ty1 @ty2 arg1 arg2
    2352 
    +           -- We don't /instantiate/ the type (though we could) so we don't know
    2353 
    +           -- if lifted or not, so we conservatively check both conditions. This
    2354 
    +           -- gives a conservative answer False for (# null xs, null ys #), but
    2355 
    +           -- these unboxed tuples are usually ANF'd so it doesn't reallly matter.
    2350 2356
    2351 2357 
     -----------------------------
    2352 2358 
     altsAreExhaustive :: [Alt b] -> Bool
    ... ... @@ -2390,8 +2396,41 @@ cantEtaReduceFun fun
    2390 2396 
            -- Don't undersaturate StrictWorkerIds.
    2391 2397 
            -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info.
    2392 2398
    2393 
    -{- Note [exprOkForSpeculation and type classes]
    2394 
    -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    2399 
    +{- Note [exprOkForSpeculation]
    2400 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    2401 
    +Suppose we have
    2402 
    +  data T a = K !a Int# a
    2403 
    +
    2404 
    +Is the call (K e1 e2 e3) ok-for-speculation?  Lok at the arguments e1..e3,
    2405 
    +and their types.  The call is ok-for-speculation if each argument satisfies
    2406 
    +`field_ok`, namely:
    2407 
    +  (a) Arg type is definitely lifted   => arg is not marked strict
    2408 
    +  (b) Arg type is definitely unlifted => (exprIsCheap arg) is True
    2409 
    +  (c) Otherwise =>  not marked strict && exprIsCheap
    2410 
    +
    2411 
    +For (a), an arbitrary /lazy/ argument is ok provided we don't have a bang.
    2412 
    +For a strict argument you might wonder if we could use exprIsHNF, but see
    2413 
    +Note [exprOkForSpeculation and evaluated variables].  So for strict arguments
    2414 
    +we just say "no".
    2415 
    +
    2416 
    +For (b) a variable, or casted variable is fine.  But not a call, say (f x).
    2417 
    +Hence `exprisCheap`.
    2418 
    +
    2419 
    +For (c) we don't know if we are in case (a) or (b) so we conservatively 'and'
    2420 
    +them.  See (EOKS1) for how we can get this situation.
    2421 
    +
    2422 
    +(EOKS1) To get the lifted-ness or otherwise of the arguments we just look at the
    2423 
    +  /uninstantiated/ type of the data constructor or primop.  We'd get better information
    2424 
    +  if we instantiated, but it's also more expensive.  Example:
    2425 
    +    (#,#) :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b -> (# a, b #)
    2426 
    +  If we have a call
    2427 
    +       (#,#) @LiftedRep @IntRep @Int @Int# 3 4#
    2428 
    +  then we could see accurate liftedness by instantiation, but we don't try.
    2429 
    +  Typically the argument is a variable, in which case `exprIsCheap` does a good job.
    2430 
    +
    2431 
    +
    2432 
    +Note [exprOkForSpeculation and type classes]
    2433 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    2395 2434 
     Consider (#22745, #15205)
    2396 2435
    2397 2436 
       \(d :: C a b). case eq_sel (sc_sel d) of

  • testsuite/tests/simplCore/should_compile/T27910.hs
    1 
    +{-# LANGUAGE UnboxedTuples, MagicHash #-}
    2 
    +module T27910 where
    3 
    +import GHC.Exts
    4 
    +
    5 
    +k1 :: (# Int, Bool #) -> (# Int, Bool #) -> Int
    6 
    +{-# NOINLINE k1 #-}
    7 
    +k1 _ _ = 3
    8 
    +
    9 
    +k2 :: (# Int#, Int# #) -> (# Int#, Int# #) -> Int
    10 
    +{-# NOINLINE k2 #-}
    11 
    +k2 _ _ = 3
    12 
    +
    13 
    +lifted :: Int -> Bool -> Int
    14 
    +lifted x y = case (# x, y #) of r -> k1 r r
    15 
    +
    16 
    +unlifted :: Int# -> Int# -> Int
    17 
    +unlifted x y = case (# x, y #) of r -> k2 r r

  • testsuite/tests/simplCore/should_compile/T27910.stderr
    1 
    +
    2 
    +==================== FloatOut stats: ====================
    3 
    +2 Lets floated to top level; 0 Lets floated elsewhere; from 4 Lambda groups
    4 
    +
    5 
    +
    6 
    +
    7 
    +==================== FloatOut stats: ====================
    8 
    +4 Lets floated to top level; 0 Lets floated elsewhere; from 6 Lambda groups
    9 
    +
    10 
    +
    11 
    +
    12 
    +==================== Grand total simplifier statistics ====================
    13 
    +Total ticks:     30
    14 
    +
    15 
    +8 PreInlineUnconditionally
    16 
    +  1 ds
    17 
    +  1 ds
    18 
    +  1 ds
    19 
    +  1 ds
    20 
    +  1 ds
    21 
    +  1 ds
    22 
    +  1 ds
    23 
    +  1 ds
    24 
    +2 PostInlineUnconditionally
    25 
    +  1 r
    26 
    +  1 r
    27 
    +4 UnfoldingDone
    28 
    +  2 GHC.Internal.Prim.void#
    29 
    +  1 T27910.k1
    30 
    +  1 T27910.k2
    31 
    +8 BetaReduction
    32 
    +  1 ds
    33 
    +  1 ds
    34 
    +  1 ds
    35 
    +  1 ds
    36 
    +  1 ds
    37 
    +  1 ds
    38 
    +  1 ds
    39 
    +  1 ds
    40 
    +4 KnownBranch
    41 
    +  2 wild
    42 
    +  1 ww
    43 
    +  1 ww
    44 
    +4 CaseElim
    45 
    +  2 ww
    46 
    +  2 ww
    47 
    +9 SimplifierDone 9
    48 
    +
    49 
    +

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -627,3 +627,5 @@ test('T27749',
    627 627 
          compile, ['-O -g3 -ddump-simpl -dsuppress-uniques'])
    628 628
    629 629 
     test('T27629', only_ways(['optasm']), makefile_test, ['T27629'])
    630 
    +test('T27910', grep_errmsg(r'KnownBranch'), compile, ['-O -dno-typeable-binds -ddump-simpl-stats -dsuppress-uniques'])
    631 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/336b87e20e8df777c38eab5361ffc4cb0e3fcf5e at 1791897556