RULES for ByteString are not fired

Kazu Yamamoto ( 山本和彦 ) kazu at iij.ad.jp
Tue Aug 28 06:37:32 CEST 2012


Hello,

I seems to us (my friends and me) that term rewriting rules for
ByteString are not fired in recent GHCs.

	6.12.3    OK
	7.0.4     NG
	7.4.1     NG
	7.6.1RC1  NG

For example, with the example from this ticket
	http://hackage.haskell.org/trac/ghc/ticket/3703
results in as follows:

% ghc -O  -ddump-simpl-stats --make breakOn.hs
14 RuleFired
  4 Class op showsPrec
  2 Class op show
  2 eqChar#->case
  2 unpack
  2 unpack-list
  1 Class op ==
  1 Class op >>

There is no ByteString rules.

Is this a bug or intention?

--Kazu

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    let string1 = B.pack "This is a string"
        string2 = B.pack "This is another string"
    print (breakOn ' ' string1)
    print (breakOn ' ' string2)

breakOn :: Char -> B.ByteString -> (B.ByteString, B.ByteString)
breakOn c = B.break (c==)





More information about the Glasgow-haskell-users mailing list