Question

我使用stream数据类型和一堆重写规则定义了一个模块。重写规则在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)
  #-}

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 *

Answer 1

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

规则在模块中有效，因为ghc可以在同一模块中自由内联函数。

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

1 个答案: