Haskell rewrite rules do not fire in another module
I have defined a module with a streaming datatype and a rewrite rule binding. The rewrite rules work fine in a module Stream
, but if I import the module Stream
into another module, the rules no longer run. What am I doing wrong?
If everything works as expected, then the rules zip/fmap/left
and zip/unfold
will be run several times.
I am using GHC 7.10.1.
Stream.hs:
module Stream (Stream,map,scan,unfold,zip,zipWith,take) where
import Prelude hiding (zipWith,head,repeat,take,splitAt,map,zip)
import Control.Arrow
data Stream a = Cons !a (Stream a)
map :: (a -> b) -> Stream a -> Stream b
map f (Cons x xs) = Cons (f x) (map f xs)
{-# NOINLINE map #-}
instance Functor Stream where
fmap = map
instance Num n => Num (Stream n) where
(+) = zipWith (+)
(*) = zipWith (*)
(-) = zipWith (-)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = repeat . fromInteger
scan :: (a -> b -> a) -> a -> Stream b -> Stream a
scan f a (Cons b bs) = Cons a (scan f (f a b) bs)
{-# NOINLINE scan #-}
unfold :: (s -> (a,s)) -> s -> Stream a
unfold f s0 =
let (a,s) = f s0
in Cons a (unfold f s)
{-# NOINLINE unfold #-}
zip :: Stream a -> Stream b -> Stream (a,b)
zip (Cons a as) (Cons b bs) = Cons (a,b) (zip as bs)
{-# NOINLINE zip #-}
zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
zipWith f as bs = fmap (uncurry f) (zip as bs)
{-# INLINE zipWith #-}
take :: Int -> Stream a -> [a]
take 0 _ = []
take n (Cons x xs) = x : take (n-1) xs
head :: Stream a -> a
head (Cons a _) = a
{-# INLINE CONLIKE head #-}
repeat :: a -> Stream a
repeat = unfold (\b -> (b,b))
{-# INLINE repeat #-}
{-# RULES
"zip/unfold" forall f g z0 z1. zip (unfold f z0) (unfold g z1) = unfold (\(s0,s1) -> let (a,s0') = f s0; (b,s1') = g s1 in ((a,b),(s0',s1'))) (z0,z1)
"map/map" forall f g as. map f (map g as) = map (f . g) as
"map/id" forall as. map id as = as
"scan/fmap" forall f g as z. scan f z (map g as) = scan (\a b -> f a (g b)) z as
"scan/scan" forall f g as z0 z1. scan f z0 (scan g z1 as) = map fst $ scan (\(a,b) c -> let gbc = g b c in (f a gbc,gbc)) (z0,z1) as
"scan/zip/left" forall f z0 as bs. zip (scan f z0 as) bs = scan (\(s,_) (a,b) -> (f s a,b)) (z0,head bs) (zip as bs)
"scan/zip/right" forall f z0 as bs. zip as (scan f z0 bs) = scan (\(_,s) (a,b) -> (a,f s b)) (head as,z0) (zip as bs)
"zip/fmap/left" forall f as bs. zip (map f as) bs = map (first f) (zip as bs)
"zip/fmap/right" forall f as bs. zip as (map f bs) = map (second f) (zip as bs)
#-}
Test.hs
module Test(test,main) where
import Prelude hiding (take)
import Stream
test :: Stream Int
test = (1 :: Stream Int) * (2 :: Stream Int) * (3 :: Stream Int) * (4 :: Stream Int)
main = take 5 test
On the console:
$ ghc -O2 -fforce-recomp -ddump-rule-firings Stream.hs Test.hs
Test.hs
[1 of 2] Compiling Stream ( Stream.hs, Stream.o )
Rule fired: Class op -
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 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 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 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 fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: SC:take0
Rule fired: SC:take0
[2 of 2] Compiling Test ( Test.hs, Test.o )
Rule fired: Class op fromInteger
Rule fired: Class op fromInteger
Rule fired: Class op *
Rule fired: Class op fromInteger
Rule fired: Class op *
Rule fired: Class op fromInteger
Rule fired: Class op *
Rule fired: SC:take0
Rule fired: Class op fromInteger
Rule fired: Class op fromInteger
Rule fired: Class op *
Rule fired: Class op fromInteger
Rule fired: integerToInt
Rule fired: Class op fromInteger
Rule fired: integerToInt
Rule fired: Class op fromInteger
Rule fired: integerToInt
Rule fired: Class op fromInteger
Rule fired: integerToInt
Rule fired: Class op *
Rule fired: Class op *
Rule fired: Class op *
Rule fired: Class op *
+3
source to share