pa-ba / compdata

Haskell library implementing "Data Types a la Carte"
http://hackage.haskell.org/package/compdata
Other
89 stars 27 forks source link

Add INLINE pragma to ana' to fire cata/build fusion #8

Closed kiripon closed 9 years ago

kiripon commented 9 years ago

In document ,it is written that ana' is a shortcut fusion variant of ana. But cata/build is not in fired rules listed by ghc -O2 -ddump-rule-firings.

kiripon% ghc -O2 -ddump-rule-firings compexample.hs
[1 of 1] Compiling Main             ( compexample.hs, compexample.o )
Rule fired: Class op +
Rule fired: Class op -
Rule fired: Class op inj'
Rule fired: Class op inj'
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op inj'
Rule fired: Class op inj'
Rule fired: Class op fmap
Rule fired: Class op show
Rule fired: Class op fmap
Rule fired: SC:run'0
Rule fired: SC:run'0
Rule fired: SC:run'0
Rule fired: SC:run'0
Rule fired: SC:run'0
Linking compexample ...

This is because ana' is not inlined before fusion. When I added INLINE pragma to ana',the cata/build rule is fired.

[1 of 1] Compiling Main             ( compexample.hs, compexample.o )
Rule fired: Class op +
Rule fired: Class op -
Rule fired: Class op inj'
Rule fired: Class op inj'
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op inj'
Rule fired: Class op inj'
Rule fired: Class op fmap
Rule fired: cata/build
Rule fired: Class op show
Linking compexample ...

I tested fusion with following code.

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
module Main (main) where
import Data.Comp
import Data.Comp.Algebra
data E a = Add a a | Val Int deriving Functor

evalAlgebra :: E Int -> Int
evalAlgebra (Add l r) = l + r
evalAlgebra (Val x) = x

eval :: Term E -> Int
eval = cata evalAlgebra

treeCoalg :: (E :<: f) => Int -> f Int
treeCoalg 0 = inj $ Val 1
treeCoalg n = let n' = n - 1 in inj $ Add n' n'

buildTree :: (Functor f, E :<: f) => Int -> Term f
buildTree = ana' treeCoalg

main :: IO ()
main = do
  print $ eval (buildTree 10)
pa-ba commented 9 years ago

Many thanks for the pull request!