[GHC] #13025: Type family reduction irregularity (change from 7.10.3 to 8.0.1)

[GHC]

#13025: Type family reduction irregularity (change from 7.10.3 to 8.0.1)
-------------------------------------+-------------------------------------
           Reporter:  acowley        |             Owner:
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:  8.0.1
           Keywords:  TypeFamilies   |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  Runtime
  Unknown/Multiple                   |  performance bug
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 I was recently made aware that [http://hackage.haskell.org/package/vinyl
 vinyl]'s performance dramatically deteriorated with GHC 8.0.1 when
 compared to GHC 7.x. Vinyl is an extensible records library that's been
 around for about four years; the aspect of its design relevant here is the
 basic HList-style indexed GADT. Care was taken in the past so that working
 with, say, a `Storable` `Vector` of records would suffer no overhead from
 `vinyl` when compared with standard records, and we have a benchmark suite
 to spot check this.

 In the move to GHC-8.0.1, it turns out that we do introduce overhead.
 Inspecting the Core reveals that the benchmark inner loop includes a
 `case` match on an `HEq_sc` value whose presence I would not expect, and
 that is not present when compiling with GHC-7.10.3:


 {{{
 case HEq_sc
          @ Nat
          @ Nat
          @ ('S 'Z)
          @ (RIndex
               '("normal", V3 Float)
               '['("tex", V2 Float), '("normal", V3 Float)])
          ($s$fRElemar:S_$s$fRElemar:S_$cp1RElem
           `cast` (N:~[0] <Nat>_N <'S 'Z>_N <RIndex
                                               '("normal",
                                                 V3 Float)
                                               '['("tex",
                                                   V2 Float),
                                                 '("normal",
                                                   V3 Float)]>_N
                   :: (('S 'Z :: Nat)
                       ~
                       (RIndex
                          '("normal", V3 Float)
                          '['("tex", V2 Float),
                            '("normal",
                              V3 Float)] :: Nat) :: Constraint)
                      ~R#
                      (('S 'Z :: Nat)
                       ~~
                       (RIndex
                          '("normal", V3 Float)
                          '['("tex", V2 Float),
                            '("normal",
                              V3 Float)] :: Nat) :: Constraint)))
   of cobox0 { __DEFAULT ->
 }}}

 I have since made an effort to reproduce the issue, and discovered more
 fragility than I expected. I am attaching two modules: `Rec.hs` defines a
 kind of record type, `Main.hs` is a test program that I will reproduce
 here,

 {{{
 {-# LANGUAGE DataKinds #-}
 module Main where
 import Rec

 type MyRec = Rec '[ '("A",Int), '("B",Int), '("C",Int) ]

 getC :: MyRec -> Int
 getC = getField (Proxy::Proxy '("C",Int))

 doubleC :: MyRec -> MyRec
 doubleC r = setC (2 * (getC r)) r
   where setC = set . (Field :: Int -> Field '("C",Int))

 main :: IO ()
 main = print (getC (Field 1 :& Field 2 :& Field 3 :& Nil :: MyRec))
 }}}

 If the `doubleC` definition is present, the Core emitted (with `-O2`)
 includes an `HEq_sc` case in the RHS of `getC`. If `doubleC` is commented
 out, that `case HEq_sc ...` is no longer present. In this example, the
 offending piece of Core is,

 {{{
 case HEq_sc
        @ Nat
        @ Nat
        @ (Index '("C", Int) '['("B", Int), '("C", Int)])
        @ ('S 'Z)
        ($s$fHasFieldkr:S_$s$fHasFieldkr:S_$cp1HasField
         `cast` (N:~[0] <Nat>_N <Index
                                   '("C", Int) '['("B", Int), '("C",
 Int)]>_N <'S 'Z>_N
                 :: ((Index '("C", Int) '['("B", Int), '("C", Int)] :: Nat)
                     ~
                     ('S 'Z :: Nat) :: Constraint)
                    ~R#
                    ((Index '("C", Int) '['("B", Int), '("C", Int)] :: Nat)
                     ~~
                     ('S 'Z :: Nat) :: Constraint)))
 of cobox1 { __DEFAULT ->
 }}}

 If the contents of `Rec.hs` are included in `Main.hs`, the `case HEq_sc
 ...` is not present in the resulting Core.

 The result of what looks like a failure to normalize the `Index` type
 family (or `RIndex` in `vinyl`) manifests as a 2x slowdown in the
 benchmark available in the `vinyl` repository.

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