[GHC] #15696: Derived Ord instance for enumerations with more than 8 elements seems to be incorrect

[GHC]

#15696: Derived Ord instance for enumerations with more than 8 elements seems to be
incorrect
-------------------------------------+-------------------------------------
        Reporter:  mrkkrp            |                Owner:  osa1
            Type:  bug               |               Status:  patch
        Priority:  highest           |            Milestone:  8.6.2
       Component:  Compiler          |              Version:  8.6.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Incorrect result  |  Unknown/Multiple
  at runtime                         |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #14677, #15155    |  Differential Rev(s):  Phab:D5196,
       Wiki Page:                    |  Phab:D5201, Phab:D5226
-------------------------------------+-------------------------------------

Comment (by osa1):

 > I don't like disabling binder swapping - it's there for a good reason!

 I don't feel strongly about this, but just out of curiosity I compared
 nofib outputs of GHC HEAD with and without this patch: (disables swapping
 case binder swapping)

 {{{
 diff --git a/compiler/simplCore/SetLevels.hs
 b/compiler/simplCore/SetLevels.hs
 index b8212c72f3..8fabf98179 100644
 --- a/compiler/simplCore/SetLevels.hs
 +++ b/compiler/simplCore/SetLevels.hs
 @@ -469,15 +469,15 @@ lvlCase env scrut_fvs scrut' case_bndr ty alts
          -- Always float the case if possible
          -- Unlike lets we don't insist that it escapes a value lambda
      do { (env1, (case_bndr' : bs')) <- cloneCaseBndrs env dest_lvl
 (case_bndr : bs)
 -       ; let rhs_env = extendCaseBndrEnv env1 case_bndr scrut'
 -       ; body' <- lvlMFE rhs_env True body
 +       -- ; let rhs_env = extendCaseBndrEnv env1 case_bndr scrut'
 +       ; body' <- lvlMFE env1 True body
         ; let alt' = (con, map (stayPut dest_lvl) bs', body')
         ; return (Case scrut' (TB case_bndr' (FloatMe dest_lvl)) ty'
 [alt']) }

    | otherwise     -- Stays put
    = do { let (alts_env1, [case_bndr']) = substAndLvlBndrs NonRecursive
 env incd_lvl [case_bndr]
 -             alts_env = extendCaseBndrEnv alts_env1 case_bndr scrut'
 -       ; alts' <- mapM (lvl_alt alts_env) alts
 +             -- alts_env = extendCaseBndrEnv alts_env1 case_bndr scrut'
 +       ; alts' <- mapM (lvl_alt alts_env1) alts
         ; return (Case scrut' case_bndr' ty' alts') }
    where
      ty' = substTy (le_subst env) ty
 @@ -1496,6 +1496,7 @@ floatTopLvlOnly le = floatToTopLevelOnly
 (le_switches le)
  incMinorLvlFrom :: LevelEnv -> Level
  incMinorLvlFrom env = incMinorLvl (le_ctxt_lvl env)

 +{-
  -- extendCaseBndrEnv adds the mapping case-bndr->scrut-var if it can
  -- See Note [Binder-swap during float-out]
  extendCaseBndrEnv :: LevelEnv
 @@ -1507,6 +1508,7 @@ extendCaseBndrEnv le@(LE { le_subst = subst, le_env
 = id_env })
    = le { le_subst   = extendSubstWithVar subst case_bndr scrut_var
         , le_env     = add_id id_env (case_bndr, scrut_var) }
  extendCaseBndrEnv env _ _ = env
 +-}

  -- See Note [Join ceiling]
  placeJoinCeiling :: LevelEnv -> LevelEnv
 }}}

 There's one -0.3% allocation in one program ("pic") with this patch, the
 rest is the same. No change in binary sizes.

 So perhaps this is not as important as we thought.

 > It would be illuminating to know (perhaps via -ticky) what code is
 improved by reverting the app_ok general case

 Have you seen comment:76? I show one example there, showing Core with and
 without the change in `app_ok`.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15696#comment:84>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler