Int vs Word performance?

Claus Reinke claus.reinke at talk21.com
Fri Feb 27 08:13:54 EST 2009


>> Here is a trivial example with drastic difference between
>> T = Int and T = Word (~2.5x here):
>>
>>    main = print $ foldl' (+) 0 [1..100000000::T]
..
>>    GHC.Prim.word2Int#
>>        (GHC.Prim.and#
>>            (GHC.Prim.int2Word# wild13_XbE)
>>            (GHC.Prim.int2Word# y#_a4EZ))
>>
>> Is that likely to cost me a lot or are these conversions cheap?
>
> Those guys are no-ops, and in general you should never see a performance
> difference. If you do, it is a bug!  There are some known cases where
> rules are missing however:

Thanks, that is one thing less to worry about. Btw, is there a "guide to
reading Core" somewhere, with emphasis on performance aspects (what
to look for when optimizing time or space usage, what to ignore, how to
make it more readable, etc)?

Until I stumbled over CORE annotations, I found it near impossible even
to find the pieces of interest for non-trivial programs, things like
-dsuppress-uniques help a little with diffs, some things look big but
are noops, etc. - that kind of helpful pragmatic knowledge (why does
it look as if source variable names aren't always preserved; why does
it use random uniques instead of de Bruijn-style disambiguation, which
wouldn't interfere with diffs and would have static semantic content;
why do the outputs look different for core2core vs dump-simpl, ..).

> Some others I'm aware of are product/sum/maximum/minimum
> on lists have specialisations for some atomic types (Int, Integer) but
> not all (needs a ticket for this too).

A quick grep shows almost no specialization at all for Word, or for
IntXX/WordXX (see below). Still, none of that seems to explain the
example repeated at the top of this message.

Claus

$ find libraries/ -name _darcs -prune -o -name *hs | xargs grep SPECIAL | grep '\<Int\|\<Word'
libraries/base/Data/List.hs:{-# SPECIALISE sum     :: [Int] -> Int #-}
libraries/base/Data/List.hs:{-# SPECIALISE sum     :: [Integer] -> Integer #-}
libraries/base/Data/List.hs:{-# SPECIALISE product :: [Int] -> Int #-}
libraries/base/Data/List.hs:{-# SPECIALISE product :: [Integer] -> Integer #-}
libraries/base/GHC/Arr.lhs:    {-# SPECIALISE instance Ix (Int,Int) #-}
libraries/base/GHC/Arr.lhs:    {-# SPECIALISE instance Ix (Int,Int,Int) #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE round    :: Float -> Int #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE properFraction :: Float  -> (Integer, Float) #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE round    :: Float -> Integer #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE round    :: Double -> Int #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
libraries/base/GHC/Float.lhs:    {-# SPECIALIZE round    :: Double -> Integer #-}
libraries/base/GHC/Real.lhs:{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
libraries/base/GHC/Real.lhs:{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}
libraries/base/GHC/Real.lhs:{-# SPECIALISE lcm :: Int -> Int -> Int #-}
libraries/bytestring/Data/ByteString/Internal.hs:{-# SPECIALIZE unpackWith :: (Word8 -> Char) -> 
ByteString -> [Char] #-}
libraries/bytestring/Data/ByteString/Internal.hs:{-# SPECIALIZE packWith :: (Char -> Word8) -> 
[Char] -> ByteString #-}
libraries/bytestring/Data/ByteString/Lazy.hs:{-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> 
ByteString #-}
libraries/bytestring/Data/ByteString/Lazy.hs:{-# SPECIALIZE unpackWith :: (Word8 -> Char) -> 
ByteString -> [Char] #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> 
Place (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> 
Place (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place 
(Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place 
(Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place 
(Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place 
(Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> 
Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> 
Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> 
Int -> Node (Elem a) -> Node (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> 
Int-> Node (Node a) -> Node (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> 
Int -> Digit (Elem a) -> Digit (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> 
Int -> Digit (Node a) -> Digit (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> 
Split (FingerTree (Elem a)) (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> 
Split (FingerTree (Node a)) (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split 
(Maybe (Digit (Elem a))) (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split 
(Maybe (Digit (Node a))) (Node a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split 
(Maybe (Digit (Elem a))) (Elem a) #-}
libraries/containers/Data/Sequence.hs:{-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split 
(Maybe (Digit (Node a))) (Node a) #-}
libraries/parallel/Control/Parallel/Strategies.hs:{-# SPECIALISE seqListN :: Int -> Strategy b -> 
Strategy [b] #-}




More information about the Glasgow-haskell-users mailing list