Simon Jakobi pushed to branch wip/sjakobi/T27296-stable-simpl at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Core/Ppr.hs
    ... ... @@ -28,10 +28,10 @@ module GHC.Core.Ppr (
    28 28 
     import GHC.Prelude
    29 29
    30 30 
     import GHC.Core
    31 
    -import GHC.Core.Stats (exprStats)
    31 
    +import GHC.Core.Stats (CoreStats(..), exprStats)
    32 32 
     import GHC.Types.Fixity (LexicalFixity(..))
    33 
    -import GHC.Types.Literal( pprLiteral )
    34 
    -import GHC.Types.Name( pprInfixName, pprPrefixName, getOccString, getSrcSpan )
    33 
    +import GHC.Types.Literal( Literal, pprLiteral )
    34 
    +import GHC.Types.Name( getOccString, getSrcSpan, pprInfixName, pprPrefixName )
    35 35 
     import GHC.Types.Var
    36 36 
     import GHC.Types.Id
    37 37 
     import GHC.Types.Id.Info
    ... ... @@ -46,8 +46,8 @@ import GHC.Types.Basic
    46 46 
     import GHC.Utils.Misc
    47 47 
     import GHC.Utils.Outputable
    48 48 
     import GHC.Utils.Panic (panic)
    49 
    -import GHC.Types.SrcLoc ( SrcSpan(..), srcSpanStartLine, srcSpanStartCol
    50 
    -                        , pprUserRealSpan )
    49 
    +import GHC.Types.SrcLoc ( SrcSpan(..), pprUserRealSpan, srcSpanStartCol
    50 
    +                        , srcSpanStartLine )
    51 51 
     import GHC.Types.Tickish
    52 52
    53 53 
     import Data.List ( sortOn )
    ... ... @@ -99,7 +99,21 @@ Uniques*, so two dumps line up across rebuilds. The sort key is:
    99 99 
          whether the OccName *contains* a '$', which marks a derived binder: a worker
    100 100 
          is @$wfoo@, but a call-site specialisation is tidied to @bar_$sfoo@ (no
    101 101 
          leading '$'), so a leading-'$' test would miss it.
    102 
    -  3. the OccName string, as a final lexical, deterministic tie-break.
    102 
    +  3. the OccName string, as a lexical, deterministic tie-break.
    103 
    +  4. a content-based tie-break on the right-hand side ('rhsKey'): the floated
    104 
    +     literal, if any, then the RHS size statistics. This matters for the
    105 
    +     anonymous floats: 'newLvlVar' builds them all with OccName "lvl" and
    106 
    +     noSrcSpan, so keys 1-3 are identical and, without this, their order would
    107 
    +     fall back to the Unique-driven input order -- exactly the churn we set out
    108 
    +     to remove. (In tidied dumps like -ddump-simpl the floats already have
    109 
    +     distinct names lvl, lvl1, ...; this tie-break additionally stabilises the
    110 
    +     untidied dumps -ddump-simpl-iterations, -dverbose-core2core etc.) It is a
    111 
    +     best-effort tie-break, not a total order: two RHSs that agree on the
    112 
    +     floated literal and on every size statistic still fall back to input
    113 
    +     order. And it is Unique-independent for the floats we target -- the one
    114 
    +     exception is a rubbish literal (LitRubbish), whose 'cmpLit' compares the
    115 
    +     underlying type with the Unique-dependent 'nonDetCmpType'; that does not
    116 
    +     arise for the numeric CAFs this targets.
    103 117
    104 118 
     Recursive groups are never split: a 'Rec' is one 'CoreBind', placed as a unit by
    105 119 
     its earliest-source member, with its members sorted by the same key.
    ... ... @@ -114,24 +128,36 @@ suffer the cross-module churn this flag addresses.
    114 128 
     useful for debugging the compiler itself.
    115 129 
     -}
    116 130
    131 
    +-- | The sort key for one top-level binder. The trailing 'RhsKey' is a
    132 
    +-- content-based tiebreak, used only when two binders agree on everything
    133 
    +-- before it. See Note [Stable Core dump order].
    134 
    +type DumpSortKey =
    135 
    +  ( Int     -- source-span bucket: 0 = real span, 1 = noSrcSpan (sorts last)
    136 
    +  , Int     -- source-span start line
    137 
    +  , Int     -- source-span start column
    138 
    +  , Int     -- $-rank: 0 = derived ($w/$s) binder, 1 = its origin
    139 
    +  , String  -- the OccName string, a lexical tiebreak
    140 
    +  , RhsKey  -- content-based tiebreak (see 'rhsKey')
    141 
    +  )
    142 
    +
    117 143 
     -- | Reorder a 'CoreProgram' into a stable, source-location-driven order for
    118 144 
     -- dumping. See Note [Stable Core dump order]. Used by 'dumpPassResult' when
    119 145 
     -- -dstable-core-dump-order is enabled.
    120 146 
     sortCoreBindingsForDump :: CoreProgram -> CoreProgram
    121 147 
     sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers
    122 148 
       where
    123 
    -    sortRecMembers (Rec prs) = Rec (sortOn (bndrKey . fst) prs)
    149 
    +    sortRecMembers (Rec prs) = Rec (sortOn (uncurry elemKey) prs)
    124 150 
         sortRecMembers b         = b
    125 151
    126 
    -    -- 'sortRecMembers' runs first, so a 'Rec' is already sorted by 'bndrKey'
    152 
    +    -- 'sortRecMembers' runs first, so a 'Rec' is already sorted by 'elemKey'
    127 153 
         -- when 'bindKey' sees it; its first member is therefore the minimum key.
    128 
    -    bindKey :: CoreBind -> (Int, Int, Int, Int, String)
    129 
    -    bindKey (NonRec b _)     = bndrKey b
    130 
    -    bindKey (Rec ((b,_):_))  = bndrKey b
    131 
    -    bindKey (Rec [])         = panic "sortCoreBindingsForDump: empty Rec"
    154 
    +    bindKey :: CoreBind -> DumpSortKey
    155 
    +    bindKey (NonRec b rhs)     = elemKey b rhs
    156 
    +    bindKey (Rec ((b,rhs):_))  = elemKey b rhs
    157 
    +    bindKey (Rec [])           = panic "sortCoreBindingsForDump: empty Rec"
    132 158
    133 
    -    bndrKey :: CoreBndr -> (Int, Int, Int, Int, String)
    134 
    -    bndrKey b = (bucket, line, col, dollar_rank, s)
    159 
    +    elemKey :: CoreBndr -> CoreExpr -> DumpSortKey
    160 
    +    elemKey b rhs = (bucket, line, col, dollar_rank, s, rhsKey rhs)
    135 161 
           where
    136 162 
             s = getOccString b
    137 163 
             (bucket, line, col) = case getSrcSpan b of
    ... ... @@ -145,6 +171,27 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers
    145 171 
             dollar_rank | '$' `elem` s = 0
    146 172 
                         | otherwise    = 1
    147 173
    174 
    +-- | A cheap tie-break on a binder's right-hand side, used to order binders that
    175 
    +-- are otherwise indistinguishable -- in practice the anonymous floats, which all
    176 
    +-- share OccName \"lvl\" and 'noSrcSpan' (see 'GHC.Core.Opt.SetLevels.newLvlVar').
    177 
    +-- It pairs the floated literal (if any, looking through the @I#@-style box and
    178 
    +-- casts/ticks) with the RHS size statistics. For its Unique-independence and
    179 
    +-- best-effort caveats see Note [Stable Core dump order].
    180 
    +type RhsKey =
    181 
    +  ( Maybe Literal              -- the floated literal, if any (Nothing sorts first)
    182 
    +  , (Int, Int, Int, Int, Int)  -- exprStats counts: terms, types, coercions, value binds, join binds
    183 
    +  )
    184 
    +
    185 
    +rhsKey :: CoreExpr -> RhsKey
    186 
    +rhsKey rhs = (litOf rhs, statsTuple (exprStats rhs))
    187 
    +  where
    188 
    +    statsTuple (CS tm ty co vb jb) = (tm, ty, co, vb, jb)
    189 
    +    litOf (Lit l)    = Just l
    190 
    +    litOf (App f a)  = case a of { Lit l -> Just l; _ -> litOf f }
    191 
    +    litOf (Cast e _) = litOf e
    192 
    +    litOf (Tick _ e) = litOf e
    193 
    +    litOf _          = Nothing
    194 
    +
    148 195 
     instance OutputableBndr b => Outputable (Bind b) where
    149 196 
         ppr bind = ppr_bind noAnn bind
    150 197

  • testsuite/tests/simplCore/should_compile/Makefile
    ... ... @@ -316,3 +316,22 @@ T27296:
    316 316 
     	    -dstable-core-dump-order T27296.hs 2> /dev/null \
    317 317 
     	    | sed -nE 's/^(\$$fEqKey|\$$fOrdKey|\$$fOrdKey_\$$ccompare|size|findI_\$$slookupG|lookupG|member|findI|\$$wrotate|rotate|insertG|insertManyI|insertTwoI|weight|balance|ratios|fromAscI)( .*)?$$/\1/p' \
    318 318 
     	    | uniq
    319 
    +
    320 
    +# Companion to T27296 that pins the ordering of *anonymous* top-level floats.
    321 
    +# See Note [Stable Core dump order] in GHC.Core.Ppr and the header of T27296b.hs.
    322 
    +# This is an *untidied* dump (-ddump-float-out), the only place the "lvl"
    323 
    +# collision is observable. The sed collapses each float-out pass header to a
    324 
    +# bare "==================== Float out ====================" separator (dropping
    325 
    +# the noisy FOS config) and drops the "Result size" and "-- RHS size" lines,
    326 
    +# leaving just the bindings of each pass -- the six lvl floats in the first pass
    327 
    +# must come out ordered by literal value (1000..6000).
    328 
    +T27296b:
    329 
    +	$(RM) -f T27296b.o T27296b.hi
    330 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-float-out -dsuppress-uniques \
    331 
    +	    -dsuppress-idinfo -dsuppress-module-prefixes -dno-typeable-binds \
    332 
    +	    -dstable-core-dump-order T27296b.hs 2> /dev/null \
    333 
    +	    | sed -E \
    334 
    +	        -e '/^=+ Float out/,/=+$$/c\==================== Float out ====================' \
    335 
    +	        -e '/^Result size of Float out/,/^  = \{terms/d' \
    336 
    +	        -e '/^-- RHS size:/d' \
    337 
    +	    | cat -s

  • testsuite/tests/simplCore/should_compile/T27296b.hs
    1 
    +-- See Note [Stable Core dump order] in GHC.Core.Ppr.
    2 
    +--
    3 
    +-- Companion to T27296 that pins the ordering of *anonymous* top-level floats.
    4 
    +-- Under -O the boxed Int constants in sel's branches are floated to top level
    5 
    +-- as separate CAFs, all of which the compiler names "lvl" with noSrcSpan (see
    6 
    +-- newLvlVar). Before -dstable-core-dump-order their dump order was the
    7 
    +-- unique-driven processing order; the flag's content-based tie-break (rhsKey)
    8 
    +-- now orders them by literal value -- here 1000..6000, despite the scrambled
    9 
    +-- source order. This dump is intentionally *untidied* (-ddump-float-out), the
    10 
    +-- only place the "lvl" collision is observable; tidied dumps like -ddump-simpl
    11 
    +-- already give the floats distinct names (lvl, lvl1, ...).
    12 
    +module T27296b (sel) where
    13 
    +
    14 
    +{-# NOINLINE sel #-}
    15 
    +sel :: Int -> Int
    16 
    +sel 0 = 5000
    17 
    +sel 1 = 1000
    18 
    +sel 2 = 4000
    19 
    +sel 3 = 2000
    20 
    +sel 4 = 3000
    21 
    +sel _ = 6000

  • testsuite/tests/simplCore/should_compile/T27296b.stdout
    1 
    +
    2 
    +==================== Float out ====================
    3 
    +
    4 
    +sel :: Int -> Int
    5 
    +sel
    6 
    +  = \ (ds :: Int) ->
    7 
    +      case ds of { I# ds ->
    8 
    +      case ds of {
    9 
    +        __DEFAULT -> lvl;
    10 
    +        0# -> lvl;
    11 
    +        1# -> lvl;
    12 
    +        2# -> lvl;
    13 
    +        3# -> lvl;
    14 
    +        4# -> lvl
    15 
    +      }
    16 
    +      }
    17 
    +
    18 
    +lvl :: Int
    19 
    +lvl = I# 1000#
    20 
    +
    21 
    +lvl :: Int
    22 
    +lvl = I# 2000#
    23 
    +
    24 
    +lvl :: Int
    25 
    +lvl = I# 3000#
    26 
    +
    27 
    +lvl :: Int
    28 
    +lvl = I# 4000#
    29 
    +
    30 
    +lvl :: Int
    31 
    +lvl = I# 5000#
    32 
    +
    33 
    +lvl :: Int
    34 
    +lvl = I# 6000#
    35 
    +
    36 
    +==================== Float out ====================
    37 
    +
    38 
    +$wsel :: Int# -> Int#
    39 
    +$wsel
    40 
    +  = \ (ww :: Int#) ->
    41 
    +      case ww of {
    42 
    +        __DEFAULT -> 6000#;
    43 
    +        0# -> 5000#;
    44 
    +        1# -> 1000#;
    45 
    +        2# -> 4000#;
    46 
    +        3# -> 2000#;
    47 
    +        4# -> 3000#
    48 
    +      }
    49 
    +
    50 
    +sel :: Int -> Int
    51 
    +sel
    52 
    +  = \ (ds :: Int) ->
    53 
    +      case ds of { I# ww -> case $wsel ww of ww { __DEFAULT -> I# ww } }
    54 
    +

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -603,3 +603,4 @@ test('T25718c', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress
    603 603 
     test('T19166', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -dno-typeable-binds'])
    604 604 
     test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O'])
    605 605 
     test('T27296', [], makefile_test, ['T27296'])
    606 
    +test('T27296b', [], makefile_test, ['T27296b'])

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