# TypeFamilies painfully slow

I'm using the TypeFamilies extension to generate types that are quite large. GHC can handle these large types fine when they are created manually, but when type families get involved, GHC's performance dies.

**Related tickets**

**Related MRs**

- !6476 Directed coercions
- !9210 (closed) Tweak isAxiom_maybe to ignore non-newtype axioms

Unlike in ticket #5321 (closed), using tail recursion does not eliminate the problem, and the order of arguments greatly affects compile time.

I've attached a file Types.hs that demonstrates the problems:

## Types.hs

```
import System.Environment
code :: Int -> String -> String -> String
code i familyTest instanceTest = concat $ map (++"\n") $
[ "{-# LANGUAGE TypeOperators,DataKinds,KindSignatures,TypeFamilies,PolyKinds,UndecidableInstances #-}"
, "import GHC.TypeLits"
, "data Nat1 = Zero | Succ Nat1"
]
++
case head familyTest of
'a' ->
[ "type family Replicate1 (n :: Nat1) (x::a) :: [a]"
, "type instance Replicate1 Zero x = '[]"
, "type instance Replicate1 (Succ n) x = x ': (Replicate1 n x)"
]
'b' ->
[ "type family Replicate1 (n :: Nat1) (x::a) :: [a]"
, "type instance Replicate1 n x = Replicate1' '[] n x "
, "type family Replicate1' (acc::[a]) (n :: Nat1) (x::a) :: [a]"
, "type instance Replicate1' acc Zero x = acc"
, "type instance Replicate1' acc (Succ n) x = Replicate1' (x ': acc) n x "
]
'c' ->
[ "type family Replicate1 (n :: Nat1) (x::a) :: [a]"
, "type instance Replicate1 n x = Replicate1' n x '[]"
, "type family Replicate1' (n :: Nat1) (x::a) (acc::[a]) :: [a]"
, "type instance Replicate1' Zero x acc = acc"
, "type instance Replicate1' (Succ n) x acc = Replicate1' n x (x ': acc)"
]
++
[ "class Class a where"
, " f :: a -> a"
, "data Data (xs::a) = X | Y"
, " deriving (Read,Show)"
, "main = print test1"
]
++
case head instanceTest of
'a' ->
[ "instance (xs ~ Replicate1 ("++mkNat1 i++") ()) => Class (Data xs) where"
, " f X = Y"
, " f Y = X"
, "test1 = f (X :: Data ( Replicate1 ("++mkNat1 i++") () ))"
]
'b' ->
[ "instance (xs ~ ("++mkList i++") ) => Class (Data xs) where"
, " f X = Y"
, " f Y = X"
, "test1 = f (X :: Data ( Replicate1 ("++mkNat1 i++") () ))"
]
'c' ->
[ "instance (xs ~ Replicate1 ("++mkNat1 i++") ()) => Class (Data xs) where"
, " f X = Y"
, " f Y = X"
, "test1 = f (X :: Data ( ("++mkList i++") ))"
]
'd' ->
[ "instance (xs ~ ("++mkList i++") ) => Class (Data xs) where"
, " f X = Y"
, " f Y = X"
, "test1 = f (X :: Data ( ("++mkList i++") ))"
]
mkList :: Int -> String
mkList 0 = " '[] "
mkList i = " () ': " ++ mkList (i-1)
mkNat1 :: Int -> String
mkNat1 0 = " Zero "
mkNat1 i = " Succ ( " ++ mkNat1 (i-1) ++ ")"
main = do
numstr : familyTest : instanceTest : xs <- getArgs
let num = read numstr :: Int
putStrLn $ code num familyTest instanceTest
```

This file generates another Haskell file which has the problems. It takes 3 flags. The first is the size of the type to generate, the second is which type family function to use, and the third is whether to call the type family or just use a manually generated type.

Here are my performance results:

Using non-tail recursion, I get these results. I have to increase the stack size based on the size of the type I want to generate.

```
$ ./Types 200 a a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=250
real 0m2.973s
$ ./Types 300 a a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=350
real 0m6.018s
$ ./Types 400 a a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=450
real 0m9.995s
$ ./Types 500 a a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=550
real 0m15.645s
```

Tail recursion generates much slower compile times for some reason, and I still need to adjust the stack size:

```
$ ./Types 200 b a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=250
real 0m16.120s
```

Changing the order of arguments to the recursive type family greatly changes the run times:

```
$ ./Types 200 c a > test.hs && time ghc test.hs > /dev/null -fcontext-stack=250
real 0m6.095s
```

Without the type family, I get MUCH better performance:

```
$ ./Types 10000 a d > test.hs && time ghc test.hs > /dev/null
real 0m2.271s
```

## Trac metadata

Trac field | Value |
---|---|

Version | 7.6.3 |

Type | Bug |

TypeOfFailure | OtherFailure |

Priority | normal |

Resolution | Unresolved |

Component | Compiler (Type checker) |

Test case | |

Differential revisions | |

BlockedBy | |

Related | #5321 (closed) |

Blocking | |

CC | |

Operating system | |

Architecture |