Defer inlining of Ord methods

This performs the same refactoring performed in D1980 for Eq on Ord,
rewriting the class operations in terms of monomorphic helpers than can
be reliably matched in rewrite rules.

3 files changed, 207 insertions, 31 deletions

diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index 62a5a68dc3..cad6607a99 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -24,11 +24,11 @@ module GHC.Int (
         uncheckedIShiftL64#, uncheckedIShiftRA64#,
         -- * Equality operators
         -- | See GHC.Classes#matching_overloaded_methods_in_rules
-        eqInt, neInt,
-        eqInt8, neInt8,
-        eqInt16, neInt16,
-        eqInt32, neInt32,
-        eqInt64, neInt64
+        eqInt, neInt, gtInt, geInt, ltInt, leInt,
+        eqInt8, neInt8, gtInt8, geInt8, ltInt8, leInt8,
+        eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16,
+        eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32,
+        eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64
     ) where
 
 import Data.Bits
@@ -54,7 +54,7 @@ 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 (Ord)
+data {-# CTYPE "HsInt8" #-} Int8 = I8# Int#
 -- ^ 8-bit signed integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -68,6 +68,22 @@ neInt8 (I8# x) (I8# y) = isTrue# (x /=# y)
 {-# INLINE [1] eqInt8 #-}
 {-# INLINE [1] neInt8 #-}
 
+instance Ord Int8 where
+    (<)  = ltInt8
+    (<=) = leInt8
+    (>=) = geInt8
+    (>)  = gtInt8
+
+{-# INLINE [1] gtInt8 #-}
+{-# INLINE [1] geInt8 #-}
+{-# INLINE [1] ltInt8 #-}
+{-# INLINE [1] leInt8 #-}
+gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool
+(I8# x) `gtInt8` (I8# y) = isTrue# (x >#  y)
+(I8# x) `geInt8` (I8# y) = isTrue# (x >=# y)
+(I8# x) `ltInt8` (I8# y) = isTrue# (x <#  y)
+(I8# x) `leInt8` (I8# y) = isTrue# (x <=# y)
+
 instance Show Int8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -226,7 +242,7 @@ 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 (Ord)
+data {-# CTYPE "HsInt16" #-} Int16 = I16# Int#
 -- ^ 16-bit signed integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -240,6 +256,22 @@ neInt16 (I16# x) (I16# y) = isTrue# (x /=# y)
 {-# INLINE [1] eqInt16 #-}
 {-# INLINE [1] neInt16 #-}
 
+instance Ord Int16 where
+    (<)  = ltInt16
+    (<=) = leInt16
+    (>=) = geInt16
+    (>)  = gtInt16
+
+{-# INLINE [1] gtInt16 #-}
+{-# INLINE [1] geInt16 #-}
+{-# INLINE [1] ltInt16 #-}
+{-# INLINE [1] leInt16 #-}
+gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool
+(I16# x) `gtInt16` (I16# y) = isTrue# (x >#  y)
+(I16# x) `geInt16` (I16# y) = isTrue# (x >=# y)
+(I16# x) `ltInt16` (I16# y) = isTrue# (x <#  y)
+(I16# x) `leInt16` (I16# y) = isTrue# (x <=# y)
+
 instance Show Int16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -403,7 +435,7 @@ instance FiniteBits Int16 where
 -- from its logical range.
 #endif
 
-data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Ord)
+data {-# CTYPE "HsInt32" #-} Int32 = I32# Int#
 -- ^ 32-bit signed integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -417,6 +449,22 @@ neInt32 (I32# x) (I32# y) = isTrue# (x /=# y)
 {-# INLINE [1] eqInt32 #-}
 {-# INLINE [1] neInt32 #-}
 
+instance Ord Int32 where
+    (<)  = ltInt32
+    (<=) = leInt32
+    (>=) = geInt32
+    (>)  = gtInt32
+
+{-# INLINE [1] gtInt32 #-}
+{-# INLINE [1] geInt32 #-}
+{-# INLINE [1] ltInt32 #-}
+{-# INLINE [1] leInt32 #-}
+gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool
+(I32# x) `gtInt32` (I32# y) = isTrue# (x >#  y)
+(I32# x) `geInt32` (I32# y) = isTrue# (x >=# y)
+(I32# x) `ltInt32` (I32# y) = isTrue# (x <#  y)
+(I32# x) `leInt32` (I32# y) = isTrue# (x <=# y)
+
 instance Show Int32 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -606,10 +654,20 @@ neInt64 (I64# x) (I64# y) = isTrue# (x `neInt64#` y)
 {-# INLINE [1] neInt64 #-}
 
 instance Ord Int64 where
-    (I64# x#) <  (I64# y#) = isTrue# (x# `ltInt64#` y#)
-    (I64# x#) <= (I64# y#) = isTrue# (x# `leInt64#` y#)
-    (I64# x#) >  (I64# y#) = isTrue# (x# `gtInt64#` y#)
-    (I64# x#) >= (I64# y#) = isTrue# (x# `geInt64#` y#)
+    (<)  = ltInt64
+    (<=) = leInt64
+    (>=) = geInt64
+    (>)  = gtInt64
+
+{-# INLINE [1] gtInt64 #-}
+{-# INLINE [1] geInt64 #-}
+{-# INLINE [1] ltInt64 #-}
+{-# INLINE [1] leInt64 #-}
+gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
+(I64# x) `gtInt64` (I64# y) = isTrue# (x `gtInt64#` y)
+(I64# x) `geInt64` (I64# y) = isTrue# (x `geInt64#` y)
+(I64# x) `ltInt64` (I64# y) = isTrue# (x `ltInt64#` y)
+(I64# x) `leInt64` (I64# y) = isTrue# (x `leInt64#` y)
 
 instance Show Int64 where
     showsPrec p x = showsPrec p (toInteger x)
@@ -773,7 +831,7 @@ 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 (Ord)
+data {-# CTYPE "HsInt64" #-} Int64 = I64# Int#
 -- ^ 64-bit signed integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -787,6 +845,22 @@ neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)
 {-# INLINE [1] eqInt64 #-}
 {-# INLINE [1] neInt64 #-}
 
+instance Ord Int64 where
+    (<)  = ltInt64
+    (<=) = leInt64
+    (>=) = geInt64
+    (>)  = gtInt64
+
+{-# INLINE [1] gtInt64 #-}
+{-# INLINE [1] geInt64 #-}
+{-# INLINE [1] ltInt64 #-}
+{-# INLINE [1] leInt64 #-}
+gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
+(I64# x) `gtInt64` (I64# y) = isTrue# (x >#  y)
+(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y)
+(I64# x) `ltInt64` (I64# y) = isTrue# (x <#  y)
+(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y)
+
 instance Show Int64 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 384cf38ebd..3424f83f71 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -33,11 +33,11 @@ module GHC.Word (
 
     -- * Equality operators
     -- | See GHC.Classes#matching_overloaded_methods_in_rules
-    eqWord, neWord,
-    eqWord8, neWord8,
-    eqWord16, neWord16,
-    eqWord32, neWord32,
-    eqWord64, neWord64
+    eqWord, neWord, gtWord, geWord, ltWord, leWord,
+    eqWord8, neWord8, gtWord8, geWord8, ltWord8, leWord8,
+    eqWord16, neWord16, gtWord16, geWord16, ltWord16, leWord16,
+    eqWord32, neWord32, gtWord32, geWord32, ltWord32, leWord32,
+    eqWord64, neWord64, gtWord64, geWord64, ltWord64, leWord64
     ) where
 
 import Data.Bits
@@ -62,7 +62,7 @@ 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 (Ord)
+data {-# CTYPE "HsWord8" #-} Word8 = W8# Word#
 -- ^ 8-bit unsigned integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -76,6 +76,22 @@ neWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y)
 {-# INLINE [1] eqWord8 #-}
 {-# INLINE [1] neWord8 #-}
 
+instance Ord Word8 where
+    (<)  = ltWord8
+    (<=) = leWord8
+    (>=) = geWord8
+    (>)  = gtWord8
+
+{-# INLINE [1] gtWord8 #-}
+{-# INLINE [1] geWord8 #-}
+{-# INLINE [1] ltWord8 #-}
+{-# INLINE [1] leWord8 #-}
+gtWord8, geWord8, ltWord8, leWord8 :: Word8 -> Word8 -> Bool
+(W8# x) `gtWord8` (W8# y) = isTrue# (x `gtWord#` y)
+(W8# x) `geWord8` (W8# y) = isTrue# (x `geWord#` y)
+(W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord#` y)
+(W8# x) `leWord8` (W8# y) = isTrue# (x `leWord#` y)
+
 instance Show Word8 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -222,7 +238,7 @@ 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 (Ord)
+data {-# CTYPE "HsWord16" #-} Word16 = W16# Word#
 -- ^ 16-bit unsigned integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -236,6 +252,22 @@ neWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y)
 {-# INLINE [1] eqWord16 #-}
 {-# INLINE [1] neWord16 #-}
 
+instance Ord Word16 where
+    (<)  = ltWord16
+    (<=) = leWord16
+    (>=) = geWord16
+    (>)  = gtWord16
+
+{-# INLINE [1] gtWord16 #-}
+{-# INLINE [1] geWord16 #-}
+{-# INLINE [1] ltWord16 #-}
+{-# INLINE [1] leWord16 #-}
+gtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool
+(W16# x) `gtWord16` (W16# y) = isTrue# (x `gtWord#` y)
+(W16# x) `geWord16` (W16# y) = isTrue# (x `geWord#` y)
+(W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord#` y)
+(W16# x) `leWord16` (W16# y) = isTrue# (x `leWord#` y)
+
 instance Show Word16 where
     showsPrec p x = showsPrec p (fromIntegral x :: Int)
 
@@ -425,7 +457,7 @@ byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))
 
 #endif
 
-data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# deriving (Ord)
+data {-# CTYPE "HsWord32" #-} Word32 = W32# Word#
 -- ^ 32-bit unsigned integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -439,6 +471,22 @@ neWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y)
 {-# INLINE [1] eqWord32 #-}
 {-# INLINE [1] neWord32 #-}
 
+instance Ord Word32 where
+    (<)  = ltWord32
+    (<=) = leWord32
+    (>=) = geWord32
+    (>)  = gtWord32
+
+{-# INLINE [1] gtWord32 #-}
+{-# INLINE [1] geWord32 #-}
+{-# INLINE [1] ltWord32 #-}
+{-# INLINE [1] leWord32 #-}
+gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool
+(W32# x) `gtWord32` (W32# y) = isTrue# (x `gtWord#` y)
+(W32# x) `geWord32` (W32# y) = isTrue# (x `geWord#` y)
+(W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord#` y)
+(W32# x) `leWord32` (W32# y) = isTrue# (x `leWord#` y)
+
 instance Num Word32 where
     (W32# x#) + (W32# y#)  = W32# (narrow32Word# (x# `plusWord#` y#))
     (W32# x#) - (W32# y#)  = W32# (narrow32Word# (x# `minusWord#` y#))
@@ -608,10 +656,20 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord64#` y)
 {-# INLINE [1] neWord64 #-}
 
 instance Ord Word64 where
-    (W64# x#) <  (W64# y#) = isTrue# (x# `ltWord64#` y#)
-    (W64# x#) <= (W64# y#) = isTrue# (x# `leWord64#` y#)
-    (W64# x#) >  (W64# y#) = isTrue# (x# `gtWord64#` y#)
-    (W64# x#) >= (W64# y#) = isTrue# (x# `geWord64#` y#)
+    (<)  = ltWord64
+    (<=) = leWord64
+    (>=) = geWord64
+    (>)  = gtWord64
+
+{-# INLINE [1] gtWord64 #-}
+{-# INLINE [1] geWord64 #-}
+{-# INLINE [1] ltWord64 #-}
+{-# INLINE [1] leWord64 #-}
+gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool
+(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord64#` y)
+(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord64#` y)
+(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord64#` y)
+(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord64#` y)
 
 instance Num Word64 where
     (W64# x#) + (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#))
@@ -719,7 +777,7 @@ 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 (Ord)
+data {-# CTYPE "HsWord64" #-} Word64 = W64# Word#
 -- ^ 64-bit unsigned integer type
 
 -- See GHC.Classes#matching_overloaded_methods_in_rules
@@ -733,6 +791,22 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y)
 {-# INLINE [1] eqWord64 #-}
 {-# INLINE [1] neWord64 #-}
 
+instance Ord Word64 where
+    (<)  = ltWord64
+    (<=) = leWord64
+    (>=) = geWord64
+    (>)  = gtWord64
+
+{-# INLINE [1] gtWord64 #-}
+{-# INLINE [1] geWord64 #-}
+{-# INLINE [1] ltWord64 #-}
+{-# INLINE [1] leWord64 #-}
+gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool
+(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord#` y)
+(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord#` y)
+(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y)
+(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y)
+
 instance Num Word64 where
     (W64# x#) + (W64# y#)  = W64# (x# `plusWord#` y#)
     (W64# x#) - (W64# y#)  = W64# (x# `minusWord#` y#)
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
index 65fdfcc993..9c40449188 100644
--- a/libraries/ghc-prim/GHC/Classes.hs
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -44,6 +44,7 @@ module GHC.Classes(
     eqFloat, eqDouble,
     -- ** Monomorphic comparison operators
     gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
+    gtWord, geWord, leWord, ltWord, compareWord, compareWord#,
 
     -- * Functions over Bool
     (&&), (||), not,
@@ -89,9 +90,9 @@ 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 inlinings delayed to phase 1. For
-instance, @Word8@\'s @Eq@ instance looks like,
+For this reason, most of the primitive types in @base@ have 'Eq' and 'Ord'
+instances defined in terms of helper functions with inlinings delayed to phase
+1. For instance, @Word8@\'s @Eq@ instance looks like,
 
 > instance Eq Word8 where
 >     (==) = eqWord8
@@ -108,7 +109,8 @@ against @eqWord8@,
 
 > {-# RULES "break -> breakByte" forall a. break (`eqWord8` x) = breakByte x #-}
 
-Currently this is only done for '(==)' and '(/=)'.
+Currently this is only done for '(==)', '(/=)', '(<)', '(<=)', '(>)', and '(>=)'
+for the types in "GHC.Word" and "GHC.Int".
 -}
 
 -- | The 'Eq' class defines equality ('==') and inequality ('/=').
@@ -328,7 +330,6 @@ instance (Ord a) => Ord [a] where
 
 deriving instance Ord Bool
 deriving instance Ord Ordering
-deriving instance Ord Word
 
 -- We don't use deriving for Ord Char, because for Ord the derived
 -- instance defines only compare, which takes two primops.  Then
@@ -388,6 +389,33 @@ compareInt# x# y#
     | isTrue# (x# ==# y#) = EQ
     | True                = GT
 
+instance Ord Word where
+    compare = compareWord
+    (<)     = ltWord
+    (<=)    = leWord
+    (>=)    = geWord
+    (>)     = gtWord
+
+-- See GHC.Classes#matching_overloaded_methods_in_rules
+{-# INLINE [1] gtWord #-}
+{-# INLINE [1] geWord #-}
+{-# INLINE [1] ltWord #-}
+{-# INLINE [1] leWord #-}
+gtWord, geWord, ltWord, leWord :: Word -> Word -> Bool
+(W# x) `gtWord` (W# y) = isTrue# (x `gtWord#` y)
+(W# x) `geWord` (W# y) = isTrue# (x `geWord#` y)
+(W# x) `ltWord` (W# y) = isTrue# (x `ltWord#` y)
+(W# x) `leWord` (W# y) = isTrue# (x `leWord#` y)
+
+compareWord :: Word -> Word -> Ordering
+(W# x#) `compareWord` (W# y#) = compareWord# x# y#
+
+compareWord# :: Word# -> Word# -> Ordering
+compareWord# x# y#
+    | isTrue# (x# `ltWord#` y#) = LT
+    | isTrue# (x# `eqWord#` y#) = EQ
+    | True                      = GT
+
 -- OK, so they're technically not part of a class...:
 
 -- Boolean functions