I'm trying to do some fusion in ghc, and I'd greatly appreciate help with the code below (which is simplified from fusion on linear maps). I've tried every variation I can think of, and always something prevents the fusion.
Help, please! Thanks, - Conal
{-# OPTIONS_GHC -O2 -Wall -fglasgow-exts -ddump-simpl -ddump-simpl-stats #-}
-- {-# OPTIONS_GHC -ddump-simpl-iterations #-}
module F where
-- | Domain of a linear map.
class AsInt a where
toInt :: a -> Int
fromInt :: Int -> a
{-# RULES
"toInt/fromInt" forall m. toInt (fromInt m) = m
#-}
{-# INLINE onInt #-}
onInt :: AsInt a => (Int -> Int) -> (a -> a)
onInt f = fromInt . f . toInt
test :: AsInt a => (Int -> Int) -> (Int -> Int) -> (a -> a)
test h g = onInt h . onInt g
-- The desired result:
--
-- test h g
-- == onInt h . onInt g
-- == (fromInt . h . toInt) . (fromInt . g . toInt)
-- == \ a -> (fromInt . h . toInt) ((fromInt . g . toInt) a)
-- == \ a -> (fromInt . h . toInt) (fromInt (g (toInt a)))
-- == \ a -> fromInt (h (toInt (fromInt (g (toInt a)))))
-- == \ a -> fromInt (h (g (toInt a)))