Haskell 重写规则未在不同模块中触发

Question

我定义了一个带有流数据类型和一堆重写规则的模块。重写规则在 Stream 模块中完美运行，但如果我在不同的模块中导入 Stream 模块，则规则不再被触发。我做错了什么？

如果一切都按预期工作，那么规则 zip/fmap/left 和 zip/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)
  #-}

<小时/>

测试.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 *

Answer 1

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

这些规则在模块内起作用，因为 ghc 可以自由地在同一模块中内联函数。