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

Commits:

7 changed files:

Changes:

  • compiler/GHC/Core/Opt/Simplify/Iteration.hs
    ... ... @@ -474,14 +474,14 @@ leaving a simpler job for demand-analysis worker/wrapper. See #19874.
    474 474
    475 475 
     Wrinkles
    476 476
    477 
    -1. We must /not/ do cast w/w on
    477 
    +(CWW1) We must /not/ do cast w/w on
    478 478 
          f = g |> co
    479 479 
        otherwise it'll just keep repeating forever! You might think this
    480 480 
        is avoided because the call to tryCastWorkerWrapper is guarded by
    481 481 
        preInlineUnconditinally, but I'm worried that a loop-breaker or an
    482 482 
        exported Id might say False to preInlineUnonditionally.
    483 483
    484 
    -2. We need to be careful with inline/noinline pragmas:
    484 
    +(CWW2) We need to be careful with inline/noinline pragmas:
    485 485 
            rec { {-# NOINLINE f #-}
    486 486 
                  f = (...g...) |> co
    487 487 
                ; g = ...f... }
    ... ... @@ -503,7 +503,7 @@ Wrinkles
    503 503 
               ; g = ...f... }
    504 504 
        c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.
    505 505
    506 
    -3. We should still do cast w/w even if `f` is INLINEABLE.  E.g.
    506 
    +(CWW3) We should still do cast w/w even if `f` is INLINEABLE.  E.g.
    507 507 
           {- f: Stable unfolding = <stable-big> -}
    508 508 
           f = (\xy. <big-body>) |> co
    509 509 
        Then we want to w/w to
    ... ... @@ -513,15 +513,29 @@ Wrinkles
    513 513 
        Notice that the stable unfolding moves to the worker!  Now demand analysis
    514 514 
        will work fine on $wf, whereas it has trouble with the original f.
    515 515 
        c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap.
    516 
    -   This point also applies to strong loopbreakers with INLINE pragmas, see
    517 
    -   wrinkle (4).
    518 516
    519 
    -4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence
    520 
    -   hasInlineUnfolding in tryCastWorkerWrapper, which responds False to
    521 
    -   loop-breakers) because they'll definitely be inlined anyway, cast and
    522 
    -   all. And if we do cast w/w for an INLINE function with arity zero, we get
    517 
    +(CWW4) We should /not/ do cast w/w for INLINE functions (hence `hasInlineUnfolding`
    518 
    +   in `tryCastWorkerWrapper`) because they'll definitely be inlined anyway, cast
    519 
    +   and all.
    520 
    +
    521 
    +   Moreover, if we do cast w/w for an INLINE function with arity zero, we get
    523 522 
        something really silly: we inline that "worker" right back into the wrapper!
    524 
    -   Worse than a no-op, because we have then lost the stable unfolding.
    523 
    +   In fact it is Much Worse than a no-op, because we have then lost the stable
    524 
    +   unfolding --- aargh!  See #26903.
    525 
    +
    526 
    +   NB: you might wonder about a loop-breaker with an INLINE pragma; after all, a
    527 
    +   loop breaker won't "definitely be inlined anyway", so arguably we should not
    528 
    +   disable cast w/w/ for it.  But a Rec group can /look/ recursive at an early
    529 
    +   stage, and subsequently /become/ non-recursive after some simplification.
    530 
    +   (This is common in instance decls; see Note [Checking for INLINE loop breakers]
    531 
    +   in GHC.Core.Lint.)  So the danger is that we'll permanently lose that stable
    532 
    +   unfolding that we specifically wanted (#26903).  Simple solution: disable cast
    533 
    +   w/w for /any/ INLINE function.  See the defn
    534 
    +   of `GHC.Types.Id.Info.hasInlineUnfolding`.
    535 
    +
    536 
    +   The danger is that an INLINE pragma on a genuninely-recursive function
    537 
    +   will kill worker-wrapper.  Well, so be it.  They are pretty suspicious anyway;
    538 
    +   see Note [Checking for INLINE loop breakers].
    525 539
    526 540 
     All these wrinkles are exactly like worker/wrapper for strictness analysis:
    527 541 
       f is the wrapper and must inline like crazy
    ... ... @@ -586,11 +600,11 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
    586 600 
       | BC_Let top_lvl is_rec <- bind_cxt  -- Not join points
    587 601 
       , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform
    588 602 
                             --            a DFunUnfolding in mk_worker_unfolding
    589 
    -  , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1
    590 
    -  , not (hasInlineUnfolding info)  -- Not INLINE things: Wrinkle 4
    591 
    -  , typeHasFixedRuntimeRep work_ty    -- Don't peel off a cast if doing so would
    592 
    -                                      -- lose the underlying runtime representation.
    593 
    -                                      -- See Note [Preserve RuntimeRep info in cast w/w]
    603 
    +  , not (exprIsTrivial rhs)          -- Not x = y |> co; see (CWW1)
    604 
    +  , not (hasInlineUnfolding info)    -- Not INLINE things: see (CWW4)
    605 
    +  , typeHasFixedRuntimeRep work_ty   -- Don't peel off a cast if doing so would
    606 
    +                                     -- lose the underlying runtime representation.
    607 
    +                                     -- See Note [Preserve RuntimeRep info in cast w/w]
    594 608 
       , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
    595 609 
                                                        -- See Note [OPAQUE pragma]
    596 610 
       = do  { uniq <- getUniqueM
    ... ... @@ -637,13 +651,13 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
    637 651 
                                   `setArityInfo`      work_arity
    638 652 
                -- We do /not/ want to transfer OccInfo, Rules
    639 653 
                -- Note [Preserve strictness in cast w/w]
    640 
    -           -- and Wrinkle 2 of Note [Cast worker/wrapper]
    654 
    +           -- and (CWW2) of Note [Cast worker/wrapper]
    641 655
    642 656 
         ----------- Worker unfolding -----------
    643 657 
         -- Stable case: if there is a stable unfolding we have to compose with (Sym co);
    644 658 
         --   the next round of simplification will do the job
    645 659 
         -- Non-stable case: use work_rhs
    646 
    -    -- Wrinkle 3 of Note [Cast worker/wrapper]
    660 
    +    -- See (CWW4) of Note [Cast worker/wrapper]
    647 661 
         mk_worker_unfolding top_lvl work_id work_rhs
    648 662 
           = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers
    649 663 
                unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })

  • compiler/GHC/Core/Opt/WorkWrap.hs
    ... ... @@ -179,8 +179,9 @@ several liked-named Ids bouncing around at the same time---absolute
    179 179 
     mischief.)
    180 180
    181 181 
     Notice that we refrain from w/w'ing an INLINE function even if it is
    182 
    -in a recursive group.  It might not be the loop breaker.  (We could
    183 
    -test for loop-breaker-hood, but I'm not sure that ever matters.)
    182 
    +in a recursive group.  It might not be the loop breaker.  (We used to
    183 
    +test for loop-breaker-hood, but see (CWW4) in Note [Cast worker/wrapper]
    184 
    +in GHC.Core.Opt.Simplify.Iteration.
    184 185
    185 186 
     Note [Worker/wrapper for INLINABLE functions]
    186 187 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Driver/Config/Core/Lint.hs
    ... ... @@ -134,8 +134,6 @@ perPassFlags dflags pass
    134 134 
                           -- there may be some INLINE knots still tied, which is tiresomely noisy
    135 135 
                           CoreDoSimplify cfg
    136 136 
                             | SimplPhase InitialPhase <- sm_phase (so_mode cfg)
    137 
    -                        -> True
    138 
    -                        | otherwise
    139 137 
                             -> False
    140 138 
                           _              -> True
    141 139

  • compiler/GHC/Types/Id/Info.hs
    ... ... @@ -610,7 +610,12 @@ hasInlineUnfolding :: IdInfo -> Bool
    610 610 
     -- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is
    611 611 
     --   (a) always inlined; that is, with an `UnfWhen` guidance, or
    612 612 
     --   (b) a DFunUnfolding which never needs to be inlined
    613 
    -hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info)
    613 
    +--
    614 
    +-- Very important that this work with `realUnfoldingInfo` and so returns
    615 
    +-- True even for a loop-breaker that has an INLINE pragma.
    616 
    +-- See (CWW4) in Note [Cast worker/wrapper] in GHC.Core.Opt.Simplify.Iteration
    617 
    +-- for discussion, and #26903 for the dire consequences of getting this wrong.
    618 
    +hasInlineUnfolding info = isInlineUnfolding (realUnfoldingInfo info)
    614 619
    615 620 
     setArityInfo :: IdInfo -> ArityInfo -> IdInfo
    616 621 
     setArityInfo info ar =

  • testsuite/tests/simplCore/should_compile/T26903.hs
    1 
    +{-# LANGUAGE DefaultSignatures #-}
    2 
    +module T26903 where
    3 
    +
    4 
    +newtype T a = MkT [a]
    5 
    +
    6 
    +class C a where
    7 
    +  op :: [a] -> [a] -> T a
    8 
    +
    9 
    +  -- This default method
    10 
    +  --  * Has an INLINE pragma
    11 
    +  --  * Is too big to inline without a pragma
    12 
    +  --  * Has arity zero
    13 
    +  {-# INLINE[1] op #-}
    14 
    +  default op :: Ord a => [a] -> [a] -> T a
    15 
    +  op = \xs ys -> MkT $ if xs>ys then reverse (reverse (reverse (reverse xs)))
    16 
    +                                else reverse (reverse (reverse (reverse (xs ++ ys))))
    17 
    +
    18 
    +instance C Int where {}
    19 
    +
    20 
    +test :: [Int] -> T Int
    21 
    +test xs = op [] xs
    22 
    +  -- We expect to see `op` inlined into the RHS of `test`
    23 
    +

  • testsuite/tests/simplCore/should_compile/T26903.stderr
    1 
    +
    2 
    +==================== Tidy Core ====================
    3 
    +Result size of Tidy Core
    4 
    +  = {terms: 127, types: 130, coercions: 48, joins: 0/0}
    5 
    +
    6 
    +$dmop
    7 
    +  = (\ @a_ahq _ $dOrd_aQd xs_atR ys_atS ->
    8 
    +       case $fOrdList_$ccompare $dOrd_aQd xs_atR ys_atS of {
    9 
    +         __DEFAULT ->
    10 
    +           reverse1
    11 
    +             (reverse1 (reverse1 (reverse1 (++ xs_atR ys_atS) []) []) []) [];
    12 
    +         GT -> reverse1 (reverse1 (reverse1 (reverse xs_atR) []) []) []
    13 
    +       })
    14 
    +    `cast` <Co:20> :: ...
    15 
    +
    16 
    +$fCInt_$cop
    17 
    +  = (\ xs_atR ys_atS ->
    18 
    +       case $fOrdList_$s$ccompare xs_atR ys_atS of {
    19 
    +         __DEFAULT ->
    20 
    +           reverse1
    21 
    +             (reverse1 (reverse1 (reverse1 (++ xs_atR ys_atS) []) []) []) [];
    22 
    +         GT -> reverse1 (reverse1 (reverse1 (reverse xs_atR) []) []) []
    23 
    +       })
    24 
    +    `cast` <Co:11> :: ...
    25 
    +
    26 
    +$fCInt1_r11s
    27 
    +  = \ xs_atR ys_atS ->
    28 
    +      case $fOrdList_$s$ccompare xs_atR ys_atS of {
    29 
    +        __DEFAULT ->
    30 
    +          reverse1
    31 
    +            (reverse1 (reverse1 (reverse1 (++ xs_atR ys_atS) []) []) []) [];
    32 
    +        GT -> reverse1 (reverse1 (reverse1 (reverse xs_atR) []) []) []
    33 
    +      }
    34 
    +
    35 
    +$fCInt = C:C ($fCInt1_r11s `cast` <Co:11> :: ...)
    36 
    +
    37 
    +test4 = reverse1 [] []
    38 
    +
    39 
    +test3 = reverse1 test4 []
    40 
    +
    41 
    +test2 = reverse1 test3 []
    42 
    +
    43 
    +test1 = reverse1 test2 []
    44 
    +
    45 
    +test
    46 
    +  = \ xs_aKW ->
    47 
    +      case $fOrdList_$s$ccompare [] xs_aKW of {
    48 
    +        __DEFAULT ->
    49 
    +          (reverse1
    50 
    +             (reverse1 (reverse1 (reverse1 (++ [] xs_aKW) []) []) []) [])
    51 
    +          `cast` <Co:3> :: ...;
    52 
    +        GT -> test1 `cast` <Co:3> :: ...
    53 
    +      }
    54 
    +
    55 
    +
    56 
    +

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -581,3 +581,4 @@ test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds'])
    581 581
    582 582 
     test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques'])
    583 583 
     test('T26826', normal, compile, ['-O'])
    584 
    +test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-all'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help