2015-07-11 65 views
3

我定义了一个流数据类型和一堆重写规则的模块。重写规则在Stream模块中完美工作,但如果我将Stream模块导入到其他模块中,则不会再触发规则。我究竟做错了什么?Haskell重写规则不在不同的模块中触发

如果一切都按预期工作,则规则zip/fmap/leftzip/unfold会触发几次。

我正在使用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 

在控制台:

$ 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 * 
+0

你需要内联'(*)'。 – cchalmers

+0

啊,这解决了这个问题。如果你把它变成答案,我会接受它。感谢cchalmers。 – SvenK

回答

3

(*)需要内联,以便规则有机会触发。

规则在模块内工作,因为ghc可以在同一个模块中内联函数。