[GHC] #11443: SPECIALIZE pragma does not work + performance drop in GHC 8.0-rc1

[GHC]

#11443: SPECIALIZE pragma does not work + performance drop in GHC 8.0-rc1
---------------------------------+----------------------------------------
        Reporter:  danilo2       |                Owner:
            Type:  bug           |               Status:  new
        Priority:  high          |            Milestone:
       Component:  Compiler      |              Version:  8.0.1-rc1
      Resolution:                |             Keywords:
Operating System:  MacOS X       |         Architecture:  Unknown/Multiple
 Type of failure:  None/Unknown  |            Test Case:
      Blocked By:                |             Blocking:
 Related Tickets:                |  Differential Rev(s):
       Wiki Page:                |
---------------------------------+----------------------------------------
Description changed by danilo2:

Old description:

> Hello!
> I've just hit a strange issue. I might missinterpret how the `SPECIALIZE`
> pragma works, but if I understand correctly, then there is a bug in GHC.
> Lets consider this simple code:
>
> module `A`:
>
> {{{
>
> {-# LANGUAGE UndecidableInstances #-}
> {-# LANGUAGE TypeOperators        #-}
> {-# LANGUAGE KindSignatures       #-}
> {-# LANGUAGE DataKinds            #-}
> {-# LANGUAGE TypeFamilies         #-}
> {-# LANGUAGE FlexibleInstances    #-}
>
> module A where
>
> import Prelude
> import GHC.TypeLits
>
> -- TF utils
>
> type family (a :: Nat) :== (b :: Nat) where
>     a :== a = 'True
>     a :== b = 'False
>
> type family If cond (a :: Nat) (b :: Nat) where
>     If 'True  a b = a
>     If 'False a b = b
>
> -- Heavy TF computations
>
> type family HeavyTF (n :: Nat) (i :: Nat) :: Nat where HeavyTF n 0 = 0
>                                                        HeavyTF n i = If
> (HeavyTF' n :== 0) (HeavyTF n (i - 1)) 1
>

> type family HeavyTF' (n :: Nat) :: Nat where HeavyTF' 0 = 0
>                                              HeavyTF' n = HeavyTF' (n -
> 1)
>

> -- Params for tests (bigger numbers = longer compile times)
>
> type family NatOf a :: Nat
> type instance NatOf Int    = 12000
> type instance NatOf String = 12000
>
> -- Type class to check GHC behavior
> class PerfC1 a where perfc1 :: a -> String
> instance CheckOk (HeavyTF 10 (NatOf a)) => PerfC1 a where perfc1 _ = "oh"
> ; {-# INLINABLE perfc1 #-}
>
> class CheckOk (n :: Nat)
> instance CheckOk 0 -- where
>
> main_cache :: IO ()
> main_cache = do
>     print $ perfc1 (1 :: Int)
>     print $ perfc1 ("a" :: String)
>

> perfc1_Int :: Int -> String
> perfc1_Int = perfc1
>

> perfc1_String :: String -> String
> perfc1_String = perfc1
>

> {-# SPECIALIZE perfc1 :: Int -> String #-}
> {-# SPECIALIZE perfc1 :: String -> String #-}
>

> -----
>
> perfc1' :: PerfC1 a => a -> String
> perfc1' = perfc1
> {-# INLINABLE perfc1' #-}
>

> {-# SPECIALIZE perfc1' :: Int -> String #-}
> {-# SPECIALIZE perfc1' :: String -> String #-}
>
> }}}
>
> module `Test1`:
>
> {{{
> import A
>
> main = do
>     print $ perfc1 (1 :: Int)
>     print $ perfc1 ("a" :: String)
> }}}
>
> module `Test2`:
>
> {{{
> import A
>
> main = do
>     print $ perfc1' (1 :: Int)
>     print $ perfc1' ("a" :: String)
> }}}
>
> module `Test3`:
>
> {{{
> import A
>
> main = do
>     print $ perfc1_Int (1 :: Int)
>     print $ perfc1_String ("a" :: String)
> }}}
>
> Compile with:
> `ghc 7.10.3` : `ghc -O2 -fenable-rewrite-rules Test<n>.hs`
> `ghc 8.0-rc1` : `ghc -O2 -fenable-rewrite-rules -freduction-depth=0
> Test<n>.hs`
>
> If module `A` was already compiled the compilation times for `ghc 7.10.3`
> were as follow:
> - `Test1`: ~ 16s
> - `Test2`: ~ 16s
> - `Test3`: almost instant
>
> And for `ghc 8.0-rc1` were as follow:
> - `Test1`: ~ 28s
> - `Test2`: ~ 28s
> - `Test3`: almost instant
>
> Here are 2 bugs to note:
>
>    1) the compilation times are much longer with new GHC
>
>    2) the specialize pragmas do not work

New description:

 Hello!
 I've just hit a strange issue. I might missinterpret how the `SPECIALIZE`
 pragma works, but if I understand correctly, then there is a bug in GHC.
 Lets consider this simple code:

 module `A`:

 {{{

 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE FlexibleInstances    #-}

 module A where

 import Prelude
 import GHC.TypeLits

 -- TF utils

 type family (a :: Nat) :== (b :: Nat) where
     a :== a = 'True
     a :== b = 'False

 type family If cond (a :: Nat) (b :: Nat) where
     If 'True  a b = a
     If 'False a b = b

 -- Heavy TF computations

 type family HeavyTF (n :: Nat) (i :: Nat) :: Nat where HeavyTF n 0 = 0
                                                        HeavyTF n i = If
 (HeavyTF' n :== 0) (HeavyTF n (i - 1)) 1


 type family HeavyTF' (n :: Nat) :: Nat where HeavyTF' 0 = 0
                                              HeavyTF' n = HeavyTF' (n - 1)


 -- Params for tests (bigger numbers = longer compile times)

 type family NatOf a :: Nat
 type instance NatOf Int    = 12000
 type instance NatOf String = 12000

 -- Type class to check GHC behavior
 class PerfC1 a where perfc1 :: a -> String
 instance CheckOk (HeavyTF 10 (NatOf a)) => PerfC1 a where perfc1 _ = "oh"
 ; {-# INLINABLE perfc1 #-}

 class CheckOk (n :: Nat)
 instance CheckOk 0 -- where

 main_cache :: IO ()
 main_cache = do
     print $ perfc1 (1 :: Int)
     print $ perfc1 ("a" :: String)


 perfc1_Int :: Int -> String
 perfc1_Int = perfc1


 perfc1_String :: String -> String
 perfc1_String = perfc1


 {-# SPECIALIZE perfc1 :: Int -> String #-}
 {-# SPECIALIZE perfc1 :: String -> String #-}


 -----

 perfc1' :: PerfC1 a => a -> String
 perfc1' = perfc1
 {-# INLINABLE perfc1' #-}


 {-# SPECIALIZE perfc1' :: Int -> String #-}
 {-# SPECIALIZE perfc1' :: String -> String #-}

 }}}

 module `Test1`:

 {{{
 import A

 main = do
     print $ perfc1 (1 :: Int)
     print $ perfc1 ("a" :: String)
 }}}

 module `Test2`:

 {{{
 import A

 main = do
     print $ perfc1' (1 :: Int)
     print $ perfc1' ("a" :: String)
 }}}

 module `Test3`:

 {{{
 import A

 main = do
     print $ perfc1_Int (1 :: Int)
     print $ perfc1_String ("a" :: String)
 }}}

 Compile with:
 `ghc 7.10.3` : `ghc -O2 -fenable-rewrite-rules Test<n>.hs`
 `ghc 8.0-rc1` : `ghc -O2 -fenable-rewrite-rules -freduction-depth=0
 Test<n>.hs`

 (I've used `-fenable-rewrite-rules` explicitly just to be sure it is
 enabled. We can omit it because `-O2` enables it)

 If module `A` was already compiled the compilation times for `ghc 7.10.3`
 were as follow:
 - `Test1`: ~ 16s
 - `Test2`: ~ 16s
 - `Test3`: almost instant

 And for `ghc 8.0-rc1` were as follow:
 - `Test1`: ~ 28s
 - `Test2`: ~ 28s
 - `Test3`: almost instant

 Here are 2 bugs to note:

    1) the compilation times are much longer with new GHC

    2) the specialize pragmas do not work

--

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