Hi Simon, the attached module illustrates the problem. I don't think it's a compiler bug. Its more that I don't understand the foldr/build fusion framework currently in use well-enough. Anyways, I'm very glad for any help.
best regards, Simon 2011/6/13 Simon Peyton-Jones <[email protected]>: > Any chance you could make a standalone example demonstrating the problem? ie > one or two modules with suitable definitions, perhaps some stubs. ({-# > NOINLINE #-} is useful for the stubs.) Not only does that make it easier to > identify what's going wrong, but it also means we can add it to the > regression suite (if there is a bug) to ensure it doesn't happen again. > > Simon > > | -----Original Message----- > | From: [email protected] [mailto:[email protected]] On > Behalf Of > | Simon Meier > | Sent: 11 June 2011 14:44 > | To: [email protected] > | Subject: Debugging non-firing rewrite rules > | > | Hi, > | > | there's quite some material on how to debug/track rewrite rules that > | do fire. However, I couldn't find information about how to find out > | what is wrong with a rule that supposedly should, but actually doesn't > | fire. Concretely, I would like to add a rewrite rule that converts > | > | mconcat . map (fromWrite w) > | > | to > | > | fromWriteList w > | > | The relevant definitions and types are: > | > | mconcat = foldr append empty > | append :: Builder -> Builder -> Builder > | empty :: Builder > | fromWrite :: Write a -> a -> Builder > | fromWriteList :: Write a -> [a] -> Builder > | > | The rewrite rule that I tried is > | > | "foldr/fromWrite" forall w. > | foldr (\x b -> append (fromWrite w x) b) empty = fromWriteList w > | > | combined with {-# INLINE [1] #-} anotations on the `append`, `empty`, > | `fromWrite` and `fromWriteList`. However, the rule doesn't fire for a > | definition like > | > | word8s :: [Word8] -> Builder > | word8s = mconcat . map (fromWrite writeWord8) > | > | I suspect that the foldr/build fusion rules are interacting. However, > | I don't know how this interaction looks like. Is there a way to track > | all simplifications of `word8s` in all phases? If there was, then I > | could formulate my rule such that it is reduced with respect to the > | other rewriting rules. Then, the interaction should work out. > | > | thanks for your help, > | Simon > | > | PS: The above definitions are part of the builder for the bytestring > | package [1] and my experiment on rule firings can be found here [2]. > | > | [1] https://github.com/meiersi/bytestring > | [2] > | > https://github.com/meiersi/bytestring/blob/master/tests/builder/WriteListFusion.hs > | > | _______________________________________________ > | Cvs-ghc mailing list > | [email protected] > | http://www.haskell.org/mailman/listinfo/cvs-ghc > >
-- | -- Created: 2011 06 14 -- Author: Simon Meier <[email protected]> -- -- Testcase for rewriting rules that involve 'foldr'. The testcase is -- motivated by the Builder being implemented for the bytestring library. -- There, we would like to exploit equations like -- -- mconcat . map (fromWrite w) = fromWriteList w -- -- in order to gain additional (2x - 10x) more efficiency. However, I could not -- formulate a rewriting rule that matches the appropriate intermediate form of -- 'mconcat . map (fromWrite w)'. The following definitions illustrate the -- problem with the same names but simpler types. -- -- See -- https://github.com/meiersi/bytestring/blob/master/Data/ByteString/Builder/Write.hs -- for more context on Writes and Builders. module Test_RewriteFoldr where import Data.Monoid import Data.List newtype Builder = Builder String deriving( Show ) {-# INLINE [1] append #-} append :: Builder -> Builder -> Builder append x (Builder "") = x append (Builder "") y = y append (Builder x ) (Builder y) = Builder (x ++ " | " ++ y) {-# INLINE [1] empty #-} empty :: Builder empty = Builder "" instance Monoid Builder where {-# INLINE mempty #-} mempty = empty {-# INLINE mappend #-} mappend = append {-# INLINE mconcat #-} mconcat = foldr mappend mempty -- | Writes are primitive serialization functions. data Write a = Write (a -> String) -- | An dummy implementation of a write for strings. writeString :: Write String writeString = Write id -- | Writes can be used to construct builders for singleton arguments... {-# INLINE [1] fromWrite #-} fromWrite :: Write a -> a -> Builder fromWrite (Write f) x = Builder ("write: " ++ f x) -- | ...as well as for lists. Here, we mark what 'fromWriteXXX' function was -- used to detect if a rewriting rule was applied or not. {-# INLINE fromWriteList #-} fromWriteList :: Write a -> [a] -> Builder fromWriteList (Write f) xs = Builder (concat $ intersperse " | " [ "writeList: " ++ f x | x <- xs]) -- In the actual implementation, 'fromWriteList w' is significantly more -- efficient than 'mconcat . map (fromWrite w)'. It moves several variables out -- of the inner loop and probably also helps the compilers strictness analyzer. -- -- This rule should convert the intermediate version of 'mconcat . map -- (fromWrite w)' and as many variants as possible to the efficient -- 'fromWriteList' version. {-# RULES "foldr/fromWrite" forall w. foldr (\x b -> append (fromWrite w x) b) empty = fromWriteList w #-} -- All of the following expressions should yield the same result when compiling -- with -O2. However, only the first two do, while the 'fails' expression gets -- probably converted to some intermediate representation that the rule doesn't -- match on. goal :: [String] -> Builder goal = fromWriteList writeString works :: [String] -> Builder works = foldr (\x b -> append (fromWrite writeString x) b) empty fails :: [String] -> Builder fails = mconcat . map (fromWrite writeString) main :: IO () main = do putStrLn "The following three results should all use 'fromWriteList':" mapM_ (print . ($ input)) [goal, works, fails] where input :: [String] input = ["hello", "world", "!"]
_______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
