Hello all,
First of all, I'm sorry that this email is so absurdly long. But it's not easy to explain the problem at hand, so I took a step-by-step approach. The executive summary is: GHC can do a great job with inlining, but often it doesn't, and I don't understand why. So I have some questions, which are highlighted in the text below. In general, any insights regarding inlining or improving the performance of generics are welcome. My final goal is to be able to state that generic functions (in particular using GHC.Generics) will have no runtime overhead whatsoever when compared to a handwritten type-specific version.
The setting
Generic programming is based on representing datatypes in a uniform way using a small set of representation types. Functions defined on those representation types can then be applied to all datatypes, because we can convert between datatypes and their representations.
However, generic functions tend to be slower than their specialised counterparts, because they have to deal with the conversions. But clever inlining (together with other compiler optimisations) can completely remove this overhead. The problem I'm tackling is how to tell GHC exactly what it should in the particular case of optimisation of generic code.
Simplified example
I'll focus on the problem of optimising a non-trivial function for generic enumeration of terms. My experience shows that GHC does quite good at optimising simple functions, especially consumers (like generic equality). But producers are trickier.
First, we'll need some auxiliary functions:
-- | Interleave elements from two lists. Similar to (++), but swap left and
-- right arguments on every recursive application.
--
-- From Mark Jones' talk at AFP2008
{-# NOINLINE (|||) #-}
(|||) :: [a] -> [a] -> [a]
[] ||| ys = ys
(x:xs) ||| ys = x : ys ||| xs
-- | Diagonalization of nested lists. Ensure that some elements from every
-- sublist will be included. Handles infinite sublists.
--
-- >From Mark Jones' talk at AFP2008
{-# NOINLINE diag #-}
diag :: [[a]] -> [a]
diag = concat . foldr skew [] . map (map (\x -> [x]))
skew :: [[a]] -> [[a]] -> [[a]]
skew [] ys = ys
skew (x:xs) ys = x : combine (++) xs ys
combine :: (a -> a -> a) -> [a] -> [a] -> [a]
combine _ xs [] = xs
combine _ [] ys = ys
combine f (x:xs) (y:ys) = f x y : combine f xs ys
data Nat = Ze | Su Nat deriving Eq
enumNat :: [Nat]
enumNat = [Ze] ||| map Su enumNat
type RepNat = Either () Nat
toNat :: RepNat -> Nat
toNat (Left ()) = Ze
toNat (Right n) = Su n
fromNat :: Nat -> RepNat
fromNat Ze = Left ()
fromNat (Su n) = Right n
enumU :: [()]
enumU = [()]
enumEither :: [a] -> [b] -> [Either a b]
enumEither ea eb = map Left ea ||| map Right eb
enumRepNat :: [RepNat]
enumRepNat = enumEither enumU enumNatFromRep
enumNatFromRep :: [Nat]
enumNatFromRep = map toNat enumRepNat
take 100 enumNat == take 100 enumNatFromRep
map toNat enumRepNat
== { inline enumRepNat }
map toNat (enumEither enumU enumNatFromRep)
== { inline enumEither }
map toNat (map Left enumU ||| map Right enumNatFromRep)
== { inline enumU }
map toNat (map Left [()] ||| map Right enumNatFromRep)
== { inline map }
map toNat ([Left ()] ||| map Right enumNatFromRep)
== { free theorem (|||): forall f a b. map f (a ||| b) = map f a ||| map f b }
map toNat [Left ()] ||| map toNat (map Right enumNatFromRep)
== { inline map }
[toNat (Left ())] ||| map toNat (map Right enumNatFromRep)
== { definition of toNat (or inline toNat + case of constant) }
[Ze] ||| map toNat (map Right enumNatFromRep)
== { functor composition law: forall f g l. map f (map g l) = map (f . g) l }
[Ze] ||| map (toNat . Right) enumNatFromRep
== { definition of toNat (or inline toNat + case of constant) }
[Ze] ||| map Su enumNatFromRep
EnumAlone.enumNatFromRep :: [EnumAlone.Nat]
[GblId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
ConLike=False, Cheap=False, Expandable=False,
Guidance=IF_ARGS [] 30 0}]
EnumAlone.enumNatFromRep =
GHC.Base.map
@ EnumAlone.RepNat
@ EnumAlone.Nat
EnumAlone.toNat
EnumAlone.enumRepNat
EnumAlone.enumRepNat [Occ=LoopBreaker] :: [EnumAlone.RepNat]
[GblId, Str=DmdType]
EnumAlone.enumRepNat =
EnumAlone.|||
@ (Data.Either.Either () EnumAlone.Nat) lvl4_rvV lvl5_rvW
{-# INLINE enumRepNat #-}
EnumAlone.enumRepNat [InlPrag=INLINE (sat-args=0)]
:: [EnumAlone.RepNat]
[GblId,
Str=DmdType,
Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=False,
ConLike=False, Cheap=False, Expandable=False,
Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False)
Tmpl= EnumAlone.enumEither
@ () @ EnumAlone.Nat EnumAlone.enumU EnumAlone.enumNatFromRep}]
EnumAlone.enumRepNat =
EnumAlone.|||
@ (Data.Either.Either () EnumAlone.Nat) lvl4_rvV lvl5_rvW
EnumAlone.enumNatFromRep [Occ=LoopBreaker] :: [EnumAlone.Nat]
[GblId, Str=DmdType]
EnumAlone.enumNatFromRep =
GHC.Base.map
@ EnumAlone.RepNat
@ EnumAlone.Nat
EnumAlone.toNat
EnumAlone.enumRepNat
enumNatFromRep = map toNat (enumEither enumU enumNatFromRep)
lvl6_rw5 :: [Data.Either.Either () EnumAlone.Nat]
[GblId]
lvl6_rw5 =
EnumAlone.|||
@ (Data.Either.Either () EnumAlone.Nat) lvl4_rw3 lvl5_rw4
EnumAlone.enumNatFromRep [Occ=LoopBreaker] :: [EnumAlone.Nat]
[GblId, Str=DmdType]
EnumAlone.enumNatFromRep =
GHC.Base.map
@ EnumAlone.RepNat @ EnumAlone.Nat EnumAlone.toNat lvl6_rw5
{-# INLINE toNat #-}
{-# INLINE enumU #-}
{-# INLINE enumEither #-}
{-# RULES "ft |||" forall f a b. map f (a ||| b) = map f a ||| map f b #-}
lvl5_ryv :: [Data.Either.Either () EnumAlone.Nat]
[GblId]
lvl5_ryv =
GHC.Base.map
@ EnumAlone.Nat
@ (Data.Either.Either () EnumAlone.Nat)
(Data.Either.Right @ () @ EnumAlone.Nat)
EnumAlone.enumNatFromRep
lvl6_ryw :: [EnumAlone.Nat]
[GblId]
lvl6_ryw =
GHC.Base.map
@ (Data.Either.Either () EnumAlone.Nat)
@ EnumAlone.Nat
EnumAlone.toNat
lvl5_ryv
EnumAlone.enumNatFromRep [Occ=LoopBreaker] :: [EnumAlone.Nat]
[GblId, Str=DmdType]
EnumAlone.enumNatFromRep =
EnumAlone.||| @ EnumAlone.Nat lvl4_ryu lvl6_ryw
{-# RULES "map/map1" forall f g l. map f (map g l) = map (f . g) l #-}
lvl3_ryD :: [Data.Either.Either () EnumAlone.Nat]
[GblId, Caf=NoCafRefs]
lvl3_ryD =
GHC.Types.:
@ (Data.Either.Either () EnumAlone.Nat)
EnumAlone.fromNat1
(GHC.Types.[] @ (Data.Either.Either () EnumAlone.Nat))
lvl4_ryE :: [EnumAlone.Nat]
[GblId]
lvl4_ryE =
GHC.Base.map
@ (Data.Either.Either () EnumAlone.Nat)
@ EnumAlone.Nat
EnumAlone.toNat
lvl3_ryD
lvl5_ryF :: [EnumAlone.Nat]
[GblId]
lvl5_ryF =
GHC.Base.map
@ EnumAlone.Nat
@ EnumAlone.Nat
EnumAlone.Su
EnumAlone.enumNatFromRep
EnumAlone.enumNatFromRep [Occ=LoopBreaker] :: [EnumAlone.Nat]
[GblId, Str=DmdType]
EnumAlone.enumNatFromRep =
EnumAlone.||| @ EnumAlone.Nat lvl4_ryE lvl5_ryF
{-# RULES "map/map2" forall f x. map f (x:[]) = (f x):[] #-}
lvl_ryA :: [EnumAlone.Nat]
[GblId, Caf=NoCafRefs]
lvl_ryA =
GHC.Types.:
@ EnumAlone.Nat EnumAlone.Ze (GHC.Types.[] @ EnumAlone.Nat)
lvl3_ryD :: [EnumAlone.Nat]
[GblId]
lvl3_ryD =
GHC.Base.map
@ EnumAlone.Nat
@ EnumAlone.Nat
EnumAlone.Su
EnumAlone.enumNatFromRep
EnumAlone.enumNatFromRep [Occ=LoopBreaker] :: [EnumAlone.Nat]
[GblId, Str=DmdType]
EnumAlone.enumNatFromRep =
EnumAlone.||| @ EnumAlone.Nat lvl_ryA lvl3_ryD
infixr 5 :+:
infixr 6 :*:
data U = U deriving (Show, Read)
data a :+: b = L a | R b deriving (Show, Read)
data a :*: b = a :*: b deriving (Show, Read)
newtype Var a = Var a deriving (Show, Read)
newtype Rec a = Rec a deriving (Show, Read)
class Representable a where
type Rep a
to :: Rep a -> a
from :: a -> Rep a
instance Representable Nat where
type Rep Nat = U :+: (Rec Nat)
from Ze = L U
from (Su n) = R (Rec n)
to (L U) = Ze
to (R (Rec n)) = Su n
class GEnum' a where
genum' :: [a]
instance GEnum' U where
{-# INLINE genum' #-}
genum' = [U]
instance (GEnum a) => GEnum' (Rec a) where
{-# INLINE genum' #-}
genum' = map Rec genum
instance (GEnum a) => GEnum' (Var a) where
{-# INLINE genum' #-}
genum' = map Var genum
instance (GEnum' f, GEnum' g) => GEnum' (f :+: g) where
{-# INLINE genum' #-}
genum' = map L genum' ||| map R genum'
instance (GEnum' f, GEnum' g) => GEnum' (f :*: g) where
{-# INLINE genum' #-}
--genum' = diag [ [ x :*: y | y <- genum' ] | x <- genum' ]
genum' = diag (map (\x -> map (\y -> x :*: y) genum') genum')
class GEnum a where
genum :: [a]
{-# INLINE genum #-}
default genum :: (Representable a, GEnum' (Rep a)) => [a]
genum = map to genum'
instance GEnum Nat
Main.$fGEnumNat_$cgenum [Occ=LoopBreaker] :: [Base.Nat]
[GblId, Str=DmdType]
Main.$fGEnumNat_$cgenum =
GHC.Base.map
@ (Base.Rep Base.Nat)
@ Base.Nat
Base.$fRepresentableNat_$cto
(lvl37_r79y
`cast` (Sym (GEnum.NTCo:GEnum') <Base.U Base.:+: (Base.Rec Base.Nat)> ;
(GEnum.GEnum' (Sym (Base.TFCo:R:RepNat)) ;
GEnum.NTCo:GEnum' <Base.Rep Base.Nat>)
:: [Base.C Base.Nat_Ze_ Base.U
Base.:+: Base.C Base.Nat_Su_ (Base.Rec Base.Nat)]
~#
[Base.Rep Base.Nat]))
instance GEnum Nat where genum = map to genum'
lvl34_r79p :: [Base.Nat]
[GblId, Caf=NoCafRefs]
lvl34_r79p =
GHC.Types.: @ Base.Nat Base.Ze (GHC.Types.[] @ Base.Nat)
lvl35_r79q :: [Base.Nat]
[GblId]
lvl35_r79q =
GHC.Base.map @ Base.Nat @ Base.Nat Base.Su Main.$fGEnumNat_$cgenum
Main.$fGEnumNat_$cgenum [Occ=LoopBreaker] :: [Base.Nat]
[GblId, Str=DmdType]
Main.$fGEnumNat_$cgenum =
GEnum.||| @ Base.Nat lvl34_r79p lvl35_r79q
data Tree a = Leaf | Bin a (Tree a) (Tree a)
instance Representable (Tree a) where
type Rep (Tree a) = U :+: (Var a :*: Rec (Tree a) :*: Rec (Tree a))
from (Bin x l r) = R (Var x :*: Rec l :*: Rec r)
from Leaf = L U
to (R (Var x :*: (Rec l) :*: (Rec r))) = Bin x l r
to (L U) = Leaf
instance GEnum (Tree Int) where genum = map to genum'
a2_r79M
:: [Base.Rec (Base.Tree GHC.Types.Int)
Base.:*: Base.Rec (Base.Tree GHC.Types.Int)]
[GblId, Str=DmdType]
a2_r79M =
GEnum.diag
@ (Base.Rec (Base.Tree GHC.Types.Int)
Base.:*: Base.Rec (Base.Tree GHC.Types.Int))
lvl8_r79L
lvl9_r79N :: [Base.Tree GHC.Types.Int]
[GblId]
lvl9_r79N =
GHC.Base.map
@ (Base.Rec (Base.Tree GHC.Types.Int)
Base.:*: Base.Rec (Base.Tree GHC.Types.Int))
@ (Base.Tree GHC.Types.Int)
lvl5_r79H
a2_r79M
Main.$fGEnumTree_$cgenum [Occ=LoopBreaker]
:: [Base.Tree GHC.Types.Int]
[GblId, Str=DmdType]
Main.$fGEnumTree_$cgenum =
GEnum.||| @ (Base.Tree GHC.Types.Int) lvl4_r79G lvl9_r79N
{-# RULES "ft/diag" forall f l. map f (diag l) = diag (map (map f) l) #-}
a1_r72i :: [Base.Rec (Base.Tree GHC.Types.Int)]
[GblId, Str=DmdType]
a1_r72i =
GHC.Base.map
@ (Base.Tree GHC.Types.Int)
@ (Base.Rec (Base.Tree GHC.Types.Int))
((\ (tpl_B1 :: Base.Tree GHC.Types.Int) -> tpl_B1)
`cast` (<Base.Tree GHC.Types.Int>
-> Sym (Base.NTCo:Rec <Base.Tree GHC.Types.Int>)
:: (Base.Tree GHC.Types.Int -> Base.Tree GHC.Types.Int)
~#
(Base.Tree GHC.Types.Int -> Base.Rec (Base.Tree GHC.Types.Int))))
Main.$fGEnumTree_$cgenum
Main.$fGEnumTree_$cgenum [Occ=LoopBreaker]
:: [Base.Tree GHC.Types.Int]
[GblId, Str=DmdType]
Main.$fGEnumTree_$cgenum =
GEnum.|||
@ (Base.Tree GHC.Types.Int)
(GHC.Types.:
@ (Base.Tree GHC.Types.Int)
(Base.Leaf @ GHC.Types.Int)
(GHC.Types.[] @ (Base.Tree GHC.Types.Int)))
(GEnum.diag
@ (Base.Tree GHC.Types.Int)
(GHC.Base.map
@ (Base.Rec (Base.Tree GHC.Types.Int))
@ [Base.Tree GHC.Types.Int]
(\ (x_a1yQ :: Base.Rec (Base.Tree GHC.Types.Int)) ->
GHC.Base.map
@ (Base.Rec (Base.Tree GHC.Types.Int))
@ (Base.Tree GHC.Types.Int)
(\ (x1_X1zB :: Base.Rec (Base.Tree GHC.Types.Int)) ->
Base.Bin
@ GHC.Types.Int
a_r72h
(x_a1yQ
`cast` (Base.NTCo:Rec <Base.Tree GHC.Types.Int>
:: Base.Rec (Base.Tree GHC.Types.Int) ~# Base.Tree GHC.Types.Int))
(x1_X1zB
`cast` (Base.NTCo:Rec <Base.Tree GHC.Types.Int>
:: Base.Rec (Base.Tree GHC.Types.Int) ~# Base.Tree GHC.Types.Int)))
a1_r72i)
a1_r72i))