Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -709,11 +709,16 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
    709 709 
           | otherwise
    710 710 
           = Nothing
    711 711
    712 
    -    -- We don't want ticks to get in the way; just push them inwards.
    713 
    -    -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#)
    712 
    +    -- Push ticks **inwards** (when possible).
    713 
    +    -- See (MC5) in Note [Merge Nested Cases].
    714 714 
         go (Tick t body)
    715 
    -      = do { (joins, alts) <- go body
    716 
    -           ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) }
    715 
    +      = do { (joins, alts) <- go body -- (MC4): any join points inside are floated out of the tick.
    716 
    +
    717 
    +             -- Abort if this would put a non-soft-scope tick in between
    718 
    +             -- a join point binding and its jumps. See (MC6).
    719 
    +           ; guard $ null joins || t `tickishScopesLike` SoftScope
    720 
    +           ; return (joins, [Alt con bs (mkTick t rhs) | Alt con bs rhs <- alts])
    721 
    +           }
    717 722
    718 723 
         go _ = Nothing
    719 724
    ... ... @@ -924,9 +929,70 @@ Wrinkles
    924 929
    925 930 
           So `mergeCaseAlts` floats out any join points. It doesn't float out
    926 931 
           non-join-points unless the /outer/ case has just one alternative; doing
    927 
    -      so would risk more allocation
    932 
    +      so would risk more allocation.
    933 
    +
    934 
    +      Note also that `mergeCaseAlts` floats join points out of ticks, for which
    935 
    +      we need to be extra careful; see (MC6).
    936 
    +
    937 
    +(MC5) We want to move ticks out of the way if possible, to prevent them from
    938 
    +      inhibiting optimisation. For example, say we have:
    939 
    +
    940 
    +        case expensive of r {
    941 
    +          C1 -> rhs1; -- happy path
    942 
    +          _  -> scctick<doEdgeCase> (case r of { C2 -> rhs2; C3 -> rhs3 })
    943 
    +        }
    944 
    +
    945 
    +      In this situation, we push the "doEdgeCase" tick **inwards** and proceed
    946 
    +      to merge cases, like so:
    947 
    +
    948 
    +        case expensive of
    949 
    +          C1 -> rhs1
    950 
    +          C2 -> scctick<doEdgeCase> rhs2
    951 
    +          C3 -> scctick<doEdgeCase> rhs3
    952 
    +
    953 
    +      This preserves the tick semantics, because this transformation:
    954 
    +
    955 
    +        1. preserves counts,
    956 
    +        2. does not move cost in or out of the tick scope.
    957 
    +
    958 
    +      (1) is clear: we will tick 'doEdgeCase' exactly in the C2/C3 alternatives,
    959 
    +      and we won't otherwise.
    960 
    +      For (2), recall that case is strict in Core. We already evaluated 'expensive',
    961 
    +      so re-scrutinising 'r' is free.
    962 
    +
    963 
    +      This means that, perhaps surprisingly, this transformation is valid for
    964 
    +      **all** ticks, including non-floatable ones.
    965 
    +
    966 
    +      In contrast, we would not want to move the tick outwards, because this:
    967 
    +
    968 
    +        - will lead to additional counting of 'doEdgeCase' in the 'C1' (happy path) case,
    969 
    +        - risks attributing the cost of evaluating 'expensive' to 'doEdgeCase'.
    970 
    +
    971 
    +(MC6) There is a dangerous interaction between (MC4) and (MC5), which can lead
    972 
    +      to invalid Core (as reported in #26642, #26929). Suppose we have:
    973 
    +
    974 
    +        case f x of r ->
    975 
    +          scctick<foo>
    976 
    +            join j y = rhs in
    977 
    +            case r of { C1 -> j 1; C2 -> bar }
    978 
    +
    979 
    +      If we naively carried out (MC4) and (MC5) together, this would result in:
    980 
    +
    981 
    +        join j y = rhs in
    982 
    +          case f x of
    983 
    +            C1 -> scctick<foo> (j 1)
    984 
    +            C2 -> scctick<foo> bar
    985 
    +
    986 
    +      This has moved the tick in between the join point binding 'j' and the
    987 
    +      join point jump, which is invalid. The simplifier cannot deal with such
    988 
    +      Core, resulting in #26642.
    989 
    +
    990 
    +      The solution: abort whenever we would position a non-soft-scope tick
    991 
    +      inside a join point in this manner.
    992 
    +      An alternative would be to float the tick outwards, but as we saw in (MC5)
    993 
    +      this risks a grave misattribution of profiling costs, so we don't do that.
    928 994
    929 
    -(MC5) See Note [Cascading case merge]
    995 
    +(MC7) See Note [Cascading case merge]
    930 996
    931 997 
     See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils
    932 998

  • m4/fptools_happy.m4
    ... ... @@ -24,13 +24,18 @@ changequote([, ])dnl
    24 24 
     ])
    25 25 
     if test ! -f compiler/GHC/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs
    26 26 
     then
    27 
    -    failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.2  is required to compile GHC"
    27 
    +    if test x"$fptools_cv_happy_version" != x; then
    28 
    +        fptools_cv_happy_version_display="version $fptools_cv_happy_version";
    29 
    +    else
    30 
    +        fptools_cv_happy_version_display="none";
    31 
    +    fi;
    32 
    +    failure_msg="Happy version == 1.20.* || >= 2.0.2 && < 2.3 is required to compile GHC. (Found: $fptools_cv_happy_version_display)"
    28 33 
         FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.20.0],
    29 34 
           [AC_MSG_ERROR([$failure_msg])])[]
    30 35 
         FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.21.0],
    31 36 
           FP_COMPARE_VERSIONS([$fptools_cv_happy_version], [-le], [2.0.1],
    32 37 
             [AC_MSG_ERROR([$failure_msg])])[])[]
    33 
    -    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.2.0],
    38 
    +    FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[2.3.0],
    34 39 
           [AC_MSG_ERROR([$failure_msg])])[]
    35 40
    36 41 
     fi

  • testsuite/tests/simplCore/should_compile/T26642.hs
    1 
    +module T26642 ( saveClobberedTemps ) where
    2 
    +
    3 
    +import Prelude   ( IO, Bool(..), Int, (>>=), (==), return )
    4 
    +import Data.Word ( Word64 )
    5 
    +
    6 
    +-------------------------------------------------------------------------------
    7 
    +
    8 
    +data Word64Map a
    9 
    +  = Bin (Word64Map a) (Word64Map a)
    10 
    +  | Tip a
    11 
    +  | Nil
    12 
    +
    13 
    +{-# NOINLINE myFoldr #-}
    14 
    +myFoldr :: (a -> b -> b) -> b -> Word64Map a -> b
    15 
    +myFoldr f = go
    16 
    +  where
    17 
    +    {-# NOINLINE go #-}
    18 
    +    go z' Nil       = z'
    19 
    +    go z' (Tip x)   = f x z'
    20 
    +    go z' (Bin l r) = go (go z' r) l
    21 
    +
    22 
    +{-# NOINLINE nonDetFold #-}
    23 
    +nonDetFold :: (b -> elt -> IO b) -> b -> Word64Map elt -> IO b
    24 
    +nonDetFold f z0 xs = myFoldr c return xs z0
    25 
    +  where
    26 
    +    {-# NOINLINE c #-}
    27 
    +    c x k z = f z x >>= k
    28 
    +
    29 
    +{-# NOINLINE myFalse #-}
    30 
    +myFalse :: Bool
    31 
    +myFalse = False
    32 
    +
    33 
    +type RealReg = Int
    34 
    +data Loc = InReg RealReg | InMem
    35 
    +
    36 
    +saveClobberedTemps :: forall instr. [RealReg] -> IO [instr]
    37 
    +saveClobberedTemps clobbered = nonDetFold maybe_spill [] Nil
    38 
    +  where
    39 
    +    {-# NOINLINE maybe_spill #-}
    40 
    +    maybe_spill :: [instr] -> Loc -> IO [instr]
    41 
    +    maybe_spill instrs !loc =
    42 
    +      case loc of
    43 
    +        InReg reg
    44 
    +          | myFalse
    45 
    +          -> return []
    46 
    +        _ -> return instrs

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -470,6 +470,8 @@ test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings
    470 470 
     # go should become a join point
    471 471 
     test('T22428', [grep_errmsg(r'jump go') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings'])
    472 472
    473 
    +test('T26642', [unless(have_profiling(), skip)], compile, ['-O -prof -fprof-auto-calls'])
    474 
    +
    473 475 
     test('T22459', normal, compile, [''])
    474 476 
     test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
    475 477 
     test('T22662', normal, compile, [''])

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