Defer inlining of Eq for primitive types
authorBen Gamari <bgamari.foss@gmail.com>
Thu, 24 Mar 2016 10:24:32 +0000 (11:24 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 24 Mar 2016 15:14:37 +0000 (16:14 +0100)
Summary:
This is one solution to #11688, wherein (==) was inlined to soon
defeating a rewrite rule provided by bytestring. Since the RHSs of Eq's
methods are simple, there is little to be gained and much to be lost by
inlining them early.

For instance, the bytestring library provides,

```lang=haskell
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
```

and a rule

```
forall x. break ((==) x) = breakByte x
```

since `breakByte` implments an optimized version of `break (== x)` for
known `x :: Word8`. If we allow `(==)` to be inlined too early, we will
prevent this rule from firing. This was the cause of #11688.

This patch just defers the `Eq` methods, although it's likely worthwhile
giving `Ord` this same treatment. This regresses compiler allocations
for T9661 by about 8% due to the additional inlining that we now require
the simplifier to perform.

Updates the `bytestring` submodule to include updated rewrite rules
which match on `eqWord8` instead of `(==)`.

Test Plan:
 * Validate, examine performance impact

Reviewers: simonpj, hvr, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1980

GHC Trac Issues: #11688

libraries/base/GHC/Char.hs
libraries/base/GHC/Float.hs
libraries/base/GHC/Int.hs
libraries/base/GHC/Word.hs
libraries/ghc-prim/GHC/Classes.hs
testsuite/tests/perf/compiler/all.T

index c2f4ec4..9e638f5 100644 (file)
@@ -1,7 +1,14 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash #-}
 
-module GHC.Char (chr) where
+module GHC.Char
+    ( -- * Utilities
+      chr
+
+      -- * Monomorphic equality operators
+      -- | See GHC.Classes#matching_overloaded_methods_in_rules
+    , eqChar, neChar
+    ) where
 
 import GHC.Base
 import GHC.Show
index 0ffefd5..7c6995a 100644 (file)
 
 #include "ieee-flpt.h"
 
-module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double#
-                , double2Int, int2Double, float2Int, int2Float )
-    where
+module GHC.Float
+   ( module GHC.Float
+   , Float(..), Double(..), Float#, Double#
+   , double2Int, int2Double, float2Int, int2Float
+
+    -- * Monomorphic equality operators
+    -- | See GHC.Classes#matching_overloaded_methods_in_rules
+   , eqFloat, eqDouble
+   ) where
 
 import Data.Maybe
 
@@ -1059,11 +1065,9 @@ divideFloat (F# x) (F# y) = F# (divideFloat# x y)
 negateFloat :: Float -> Float
 negateFloat (F# x)        = F# (negateFloat# x)
 
-gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool
+gtFloat, geFloat, ltFloat, leFloat :: Float -> Float -> Bool
 gtFloat     (F# x) (F# y) = isTrue# (gtFloat# x y)
 geFloat     (F# x) (F# y) = isTrue# (geFloat# x y)
-eqFloat     (F# x) (F# y) = isTrue# (eqFloat# x y)
-neFloat     (F# x) (F# y) = isTrue# (neFloat# x y)
 ltFloat     (F# x) (F# y) = isTrue# (ltFloat# x y)
 leFloat     (F# x) (F# y) = isTrue# (leFloat# x y)
 
@@ -1099,11 +1103,9 @@ divideDouble (D# x) (D# y) = D# (x /## y)
 negateDouble :: Double -> Double
 negateDouble (D# x)        = D# (negateDouble# x)
 
-gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool
+gtDouble, geDouble, leDouble, ltDouble :: Double -> Double -> Bool
 gtDouble    (D# x) (D# y) = isTrue# (x >##  y)
 geDouble    (D# x) (D# y) = isTrue# (x >=## y)
-eqDouble    (D# x) (D# y) = isTrue# (x ==## y)
-neDouble    (D# x) (D# y) = isTrue# (x /=## y)
 ltDouble    (D# x) (D# y) = isTrue# (x <##  y)
 leDouble    (D# x) (D# y) = isTrue# (x <=## y)
 
index c2bb9ab..558d30d 100644 (file)
 #include "MachDeps.h"
 
 module GHC.Int (
-        Int8(..), Int16(..), Int32(..), Int64(..),
-        uncheckedIShiftL64#, uncheckedIShiftRA64#
+        Int(..), Int8(..), Int16(..), Int32(..), Int64(..),
+        uncheckedIShiftL64#, uncheckedIShiftRA64#,
+        -- * Equality operators
+        -- | See GHC.Classes#matching_overloaded_methods_in_rules
+        eqInt, neInt,
+        eqInt8, neInt8,
+        eqInt16, neInt16,
+        eqInt32, neInt32,
+        eqInt64, neInt64
     ) where
 
 import Data.Bits
@@ -47,9 +54,20 @@ import GHC.Show
 -- Int8 is represented in the same way as Int. Operations may assume
 -- and must ensure that it holds only values from its logical range.
 
-data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord)
+data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Ord)
 -- ^ 8-bit signed integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Int8 where
+    (==) = eqInt8
+    (/=) = neInt8
+
+eqInt8, neInt8 :: Int8 -> Int8 -> Bool
+eqInt8 (I8# x) (I8# y) = isTrue# (x ==# y)
+neInt8 (I8# x) (I8# y) = isTrue# (x /=# y)
+{-# INLINE [1] eqInt8 #-}
+{-# INLINE [1] neInt8 #-}
+
 instance Show Int8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -208,9 +226,20 @@ instance FiniteBits Int8 where
 -- Int16 is represented in the same way as Int. Operations may assume
 -- and must ensure that it holds only values from its logical range.
 
-data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord)
+data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Ord)
 -- ^ 16-bit signed integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Int16 where
+    (==) = eqInt16
+    (/=) = neInt16
+
+eqInt16, neInt16 :: Int16 -> Int16 -> Bool
+eqInt16 (I16# x) (I16# y) = isTrue# (x ==# y)
+neInt16 (I16# x) (I16# y) = isTrue# (x /=# y)
+{-# INLINE [1] eqInt16 #-}
+{-# INLINE [1] neInt16 #-}
+
 instance Show Int16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -374,9 +403,20 @@ instance FiniteBits Int16 where
 -- from its logical range.
 #endif
 
-data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord)
+data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Ord)
 -- ^ 32-bit signed integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Int32 where
+    (==) = eqInt32
+    (/=) = neInt32
+
+eqInt32, neInt32 :: Int32 -> Int32 -> Bool
+eqInt32 (I32# x) (I32# y) = isTrue# (x ==# y)
+neInt32 (I32# x) (I32# y) = isTrue# (x /=# y)
+{-# INLINE [1] eqInt32 #-}
+{-# INLINE [1] neInt32 #-}
+
 instance Show Int32 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -554,9 +594,16 @@ instance Ix Int32 where
 data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64#
 -- ^ 64-bit signed integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
 instance Eq Int64 where
-    (I64# x#) == (I64# y#) = isTrue# (x# `eqInt64#` y#)
-    (I64# x#) /= (I64# y#) = isTrue# (x# `neInt64#` y#)
+    (==) = eqInt64
+    (/=) = neInt64
+
+eqInt64, neInt64 :: Int64 -> Int64 -> Bool
+eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)
+neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)
+{-# INLINE [1] eqInt64 #-}
+{-# INLINE [1] neInt64 #-}
 
 instance Ord Int64 where
     (I64# x#) <  (I64# y#) = isTrue# (x# `ltInt64#` y#)
@@ -726,9 +773,20 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64#
 -- Operations may assume and must ensure that it holds only values
 -- from its logical range.
 
-data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord)
+data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Ord)
 -- ^ 64-bit signed integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Int64 where
+    (==) = eqInt64
+    (/=) = neInt64
+
+eqInt64, neInt64 :: Int64 -> Int64 -> Bool
+eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)
+neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)
+{-# INLINE [1] eqInt64 #-}
+{-# INLINE [1] neInt64 #-}
+
 instance Show Int64 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
index 6663f59..5022ffd 100644 (file)
 
 module GHC.Word (
     Word(..), Word8(..), Word16(..), Word32(..), Word64(..),
+
+    -- * Shifts
     uncheckedShiftL64#,
     uncheckedShiftRL64#,
+
+    -- * Byte swapping
     byteSwap16,
     byteSwap32,
-    byteSwap64
+    byteSwap64,
+
+    -- * Equality operators
+    -- | See GHC.Classes#matching_overloaded_methods_in_rules
+    eqWord, neWord,
+    eqWord8, neWord8,
+    eqWord16, neWord16,
+    eqWord32, neWord32,
+    eqWord64, neWord64
     ) where
 
 import Data.Bits
@@ -50,9 +62,20 @@ import GHC.Show
 -- Word8 is represented in the same way as Word. Operations may assume
 -- and must ensure that it holds only values from its logical range.
 
-data {-# CTYPE "HsWord8" #-} Word8 = W8# Word# deriving (Eq, Ord)
+data {-# CTYPE "HsWord8" #-} Word8 = W8# Word# deriving (Ord)
 -- ^ 8-bit unsigned integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Word8 where
+    (==) = eqWord8
+    (/=) = neWord8
+
+eqWord8, neWord8 :: Word8 -> Word8 -> Bool
+eqWord8 (W8# x) (W8# y) = isTrue# (x `eqWord#` y)
+neWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y)
+{-# INLINE [1] eqWord8 #-}
+{-# INLINE [1] neWord8 #-}
+
 instance Show Word8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -199,9 +222,20 @@ instance FiniteBits Word8 where
 -- Word16 is represented in the same way as Word. Operations may assume
 -- and must ensure that it holds only values from its logical range.
 
-data {-# CTYPE "HsWord16" #-} Word16 = W16# Word# deriving (Eq, Ord)
+data {-# CTYPE "HsWord16" #-} Word16 = W16# Word# deriving (Ord)
 -- ^ 16-bit unsigned integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Word16 where
+    (==) = eqWord16
+    (/=) = neWord16
+
+eqWord16, neWord16 :: Word16 -> Word16 -> Bool
+eqWord16 (W16# x) (W16# y) = isTrue# (x `eqWord#` y)
+neWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y)
+{-# INLINE [1] eqWord16 #-}
+{-# INLINE [1] neWord16 #-}
+
 instance Show Word16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -391,9 +425,20 @@ byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))
 
 #endif
 
-data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# deriving (Eq, Ord)
+data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# deriving (Ord)
 -- ^ 32-bit unsigned integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Word32 where
+    (==) = eqWord32
+    (/=) = neWord32
+
+eqWord32, neWord32 :: Word32 -> Word32 -> Bool
+eqWord32 (W32# x) (W32# y) = isTrue# (x `eqWord#` y)
+neWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y)
+{-# INLINE [1] eqWord32 #-}
+{-# INLINE [1] neWord32 #-}
+
 instance Num Word32 where
     (W32# x#) + (W32# y#)  = W32# (narrow32Word# (x# `plusWord#` y#))
     (W32# x#) - (W32# y#)  = W32# (narrow32Word# (x# `minusWord#` y#))
@@ -551,9 +596,16 @@ byteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))
 data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64#
 -- ^ 64-bit unsigned integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
 instance Eq Word64 where
-    (W64# x#) == (W64# y#) = isTrue# (x# `eqWord64#` y#)
-    (W64# x#) /= (W64# y#) = isTrue# (x# `neWord64#` y#)
+    (==) = eqWord64
+    (/=) = neWord64
+
+eqWord64, neWord64 :: Word64 -> Word64 -> Bool
+eqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord#` y)
+neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y)
+{-# INLINE [1] eqWord64 #-}
+{-# INLINE [1] neWord64 #-}
 
 instance Ord Word64 where
     (W64# x#) <  (W64# y#) = isTrue# (x# `ltWord64#` y#)
@@ -667,9 +719,20 @@ a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##
 -- Operations may assume and must ensure that it holds only values
 -- from its logical range.
 
-data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# deriving (Eq, Ord)
+data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# deriving (Ord)
 -- ^ 64-bit unsigned integer type
 
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+instance Eq Word64 where
+    (==) = eqWord64
+    (/=) = neWord64
+
+eqWord64, neWord64 :: Word64 -> Word64 -> Bool
+eqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord#` y)
+neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y)
+{-# INLINE [1] eqWord64 #-}
+{-# INLINE [1] neWord64 #-}
+
 instance Num Word64 where
     (W64# x#) + (W64# y#)  = W64# (x# `plusWord#` y#)
     (W64# x#) - (W64# y#)  = W64# (x# `minusWord#` y#)
index 19192fb..a9d5111 100644 (file)
@@ -34,8 +34,16 @@ module GHC.Classes(
     IP(..),
 
     -- * Equality and ordering
-    Eq(..), eqInt, neInt,
-    Ord(..), gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
+    Eq(..),
+    Ord(..),
+    -- ** Monomorphic equality operators
+    -- | See GHC.Classes#matching_overloaded_methods_in_rules
+    eqInt, neInt,
+    eqWord, neWord,
+    eqChar, neChar,
+    eqFloat, eqDouble,
+    -- ** Monomorphic comparison operators
+    gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
 
     -- * Functions over Bool
     (&&), (||), not,
@@ -65,6 +73,43 @@ default ()              -- Double isn't available yet
 class IP (x :: Symbol) a | x -> a where
   ip :: a
 
+{- $matching_overloaded_methods_in_rules
+
+Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit
+fragile. For instance, consider this motivating example from the @bytestring@
+library,
+
+> break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
+> breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
+> {-# RULES "break -> breakByte" forall a. break (== x) = breakByte x #-}
+
+Here we have two functions, with @breakByte@ providing an optimized
+implementation of @break@ where the predicate is merely testing for equality
+with a known @Word8@. As written, however, this rule will be quite fragile as
+the @(==)@ class operation rule may rewrite the predicate before our @break@
+rule has a chance to fire.
+
+For this reason, most of the primitive types in @base@ have 'Eq' instances
+defined in terms of helper functions with delayed inlinings. For instance,
+@Word8@\'s @Eq@ instance looks like,
+
+> instance Eq Word8 where
+>     (==) = eqWord8
+>     (/=) = neWord8
+>
+> eqWord8, neWord8 :: Word8 -> Word8 -> Bool
+> eqWord8 (W8# x) (W8# y) = ...
+> neWord8 (W8# x) (W8# y) = ...
+> {-# INLINE [1] eqWord8 #-}
+> {-# INLINE [1] neWord8 #-}
+
+This allows us to save our @break@ rule above by rewriting it to instead match
+against @eqWord8@,
+
+> {-# RULES "break -> breakByte" forall a. break (`eqWord8` x) = breakByte x #-}
+
+Currently this is only done for '(==)' and '(/=)'.
+-}
 
 -- | The 'Eq' class defines equality ('==') and inequality ('/=').
 -- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
@@ -126,24 +171,48 @@ instance (Eq a) => Eq [a] where
 
 deriving instance Eq Bool
 deriving instance Eq Ordering
-deriving instance Eq Word
 
+instance Eq Word where
+    (==) = eqWord
+    (/=) = neWord
+
+{-# INLINE [1] eqWord #-}
+{-# INLINE [1] neWord #-}
+eqWord, neWord :: Word -> Word -> Bool
+(W# x) `eqWord` (W# y) = isTrue# (x `eqWord#` y)
+(W# x) `neWord` (W# y) = isTrue# (x `neWord#` y)
+
+-- See GHC.Classes#matching_overloaded_methods_in_rules
 instance Eq Char where
-    (C# c1) == (C# c2) = isTrue# (c1 `eqChar#` c2)
-    (C# c1) /= (C# c2) = isTrue# (c1 `neChar#` c2)
+    (==) = eqChar
+    (/=) = neChar
+
+{-# INLINE [1] eqChar #-}
+{-# INLINE [1] neChar #-}
+eqChar, neChar :: Char -> Char -> Bool
+(C# x) `eqChar` (C# y) = isTrue# (x `eqChar#` y)
+(C# x) `neChar` (C# y) = isTrue# (x `neChar#` y)
 
 instance Eq Float where
-    (F# x) == (F# y) = isTrue# (x `eqFloat#` y)
+    (==) = eqFloat
+
+{-# INLINE [1] eqFloat #-}
+eqFloat :: Float -> Float -> Bool
+(F# x) `eqFloat` (F# y) = isTrue# (x `eqFloat#` y)
 
 instance Eq Double where
-    (D# x) == (D# y) = isTrue# (x ==## y)
+    (==) = eqDouble
+
+{-# INLINE [1] eqDouble #-}
+eqDouble :: Double -> Double -> Bool
+(D# x) `eqDouble` (D# y) = isTrue# (x ==## y)
 
 instance Eq Int where
     (==) = eqInt
     (/=) = neInt
 
-{-# INLINE eqInt #-}
-{-# INLINE neInt #-}
+{-# INLINE [1] eqInt #-}
+{-# INLINE [1] neInt #-}
 eqInt, neInt :: Int -> Int -> Bool
 (I# x) `eqInt` (I# y) = isTrue# (x ==# y)
 (I# x) `neInt` (I# y) = isTrue# (x /=# y)
index b8bd0b7..6b85b4a 100644 (file)
@@ -725,13 +725,14 @@ test('T9872d',
 test('T9961',
      [ only_ways(['normal']),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 519436672, 5),
+          [(wordsize(64), 568526784, 5),
           # 2015-01-12    807117816   Initally created
           # 2015-spring   772510192   Got better
           # 2015-05-22    663978160   Fix for #10370 improves it more
           # 2015-10-28    708680480   x86_64/Linux   Emit Typeable at definition site
           # 2015-12-17    745044392   x86_64/Darwin  Creep upwards
-          # 2016-03-20    519436672   x64_64/Linux   Don't use build desugaring for large lists (D2007)
+          # 2016-03-20    519436672   x64_64/Linux   Don't use build desugaring for large lists (#11707)
+          # 2016-03-24    568526784   x64_64/Linux   Add eqInt* variants (#11688)
            (wordsize(32), 375647160, 5)
           ]),
       ],