FIX #1434

Rewrite rules for RealFrac methods with sized Int and Word targets.
For all types whose range is contained in Int's range, there are now
rewrite rules for properFraction, truncate, floor, ceiling and round
from Double and Float, going through the specialised methods for Int.

Unfortunately, we can't have a rewrite rule for Word.

diff --git a/GHC/Int.hs b/GHC/Int.hs
index 9f53937..0f451b4 100644 (file)
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -40,6 +40,7 @@ import GHC.Arr
 import GHC.Err
 import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
 import GHC.Show
+import GHC.Float ()     -- for RealFrac methods
 
 ------------------------------------------------------------------------
 -- type Int8
@@ -153,6 +154,36 @@ instance Bits Int8 where
 "fromIntegral/Int8->a"    fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
   #-}
 
+{-# RULES
+"properFraction/Float->(Int8,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y) }
+"truncate/Float->Int8"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Int8) (truncate x)
+"floor/Float->Int8"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Int8) (floor x)
+"ceiling/Float->Int8"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Int8) (ceiling x)
+"round/Float->Int8"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Int8) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int8,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y) }
+"truncate/Double->Int8"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Int8) (truncate x)
+"floor/Double->Int8"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Int8) (floor x)
+"ceiling/Double->Int8"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Int8) (ceiling x)
+"round/Double->Int8"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Int8) (round x)
+  #-}
+
 ------------------------------------------------------------------------
 -- type Int16
 ------------------------------------------------------------------------
@@ -268,6 +299,36 @@ instance Bits Int16 where
 "fromIntegral/Int16->a"      fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
   #-}
 
+{-# RULES
+"properFraction/Float->(Int16,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y) }
+"truncate/Float->Int16"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Int16) (truncate x)
+"floor/Float->Int16"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Int16) (floor x)
+"ceiling/Float->Int16"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Int16) (ceiling x)
+"round/Float->Int16"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Int16) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int16,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y) }
+"truncate/Double->Int16"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Int16) (truncate x)
+"floor/Double->Int16"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Int16) (floor x)
+"ceiling/Double->Int16"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Int16) (ceiling x)
+"round/Double->Int16"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Int16) (round x)
+  #-}
+
 ------------------------------------------------------------------------
 -- type Int32
 ------------------------------------------------------------------------
@@ -403,7 +464,8 @@ instance Bits Int32 where
 "fromIntegral/Int32->Int32"  fromIntegral = id :: Int32 -> Int32
   #-}
 
-#else 
+-- No rules for RealFrac methods if Int32 is larger than Int
+#else
 
 -- Int32 is represented in the same way as Int.
 #if WORD_SIZE_IN_BITS > 32
@@ -512,7 +574,37 @@ instance Bits Int32 where
 "fromIntegral/Int32->a"      fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
   #-}
 
-#endif 
+{-# RULES
+"properFraction/Float->(Int32,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y) }
+"truncate/Float->Int32"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Int32) (truncate x)
+"floor/Float->Int32"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Int32) (floor x)
+"ceiling/Float->Int32"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Int32) (ceiling x)
+"round/Float->Int32"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Int32) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int32,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y) }
+"truncate/Double->Int32"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Int32) (truncate x)
+"floor/Double->Int32"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Int32) (floor x)
+"ceiling/Double->Int32"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Int32) (ceiling x)
+"round/Double->Int32"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Int32) (round x)
+  #-}
+
+#endif
 
 instance Real Int32 where
     toRational x = toInteger x % 1
@@ -672,7 +764,9 @@ a `iShiftRA64#` b | b >=# 64# = if a `ltInt64#` (intToInt64# 0#)
 "fromIntegral/Int64->Int64"  fromIntegral = id :: Int64 -> Int64
   #-}
 
-#else 
+-- No RULES for RealFrac methods if Int is smaller than Int64, we can't
+-- go through Int and whether going through Integer is faster is uncertain.
+#else
 
 -- Int64 is represented in the same way as Int.
 -- Operations may assume and must ensure that it holds only values
@@ -765,6 +859,36 @@ instance Bits Int64 where
 "fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
   #-}
 
+{-# RULES
+"properFraction/Float->(Int64,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y) }
+"truncate/Float->Int64"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Int64) (truncate x)
+"floor/Float->Int64"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Int64) (floor x)
+"ceiling/Float->Int64"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Int64) (ceiling x)
+"round/Float->Int64"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Int64) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int64,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y) }
+"truncate/Double->Int64"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Int64) (truncate x)
+"floor/Double->Int64"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Int64) (floor x)
+"ceiling/Double->Int64"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Int64) (ceiling x)
+"round/Double->Int64"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Int64) (round x)
+  #-}
+
 uncheckedIShiftL64# :: Int# -> Int# -> Int#
 uncheckedIShiftL64#  = uncheckedIShiftL#
 

diff --git a/GHC/Word.hs b/GHC/Word.hs
index 079f494..2ba026c 100644 (file)
--- a/GHC/Word.hs
+++ b/GHC/Word.hs
@@ -42,6 +42,7 @@ import GHC.Read
 import GHC.Arr
 import GHC.Show
 import GHC.Err
+import GHC.Float ()     -- for RealFrac methods
 
 ------------------------------------------------------------------------
 -- Helper functions
@@ -187,6 +188,10 @@ instance Bits Word where
 "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word
   #-}
 
+-- No RULES for RealFrac unfortunately.
+-- Going through Int isn't possible because Word's range is not
+-- included in Int's, going through Integer may or may not be slower.
+
 ------------------------------------------------------------------------
 -- type Word8
 ------------------------------------------------------------------------
@@ -288,6 +293,36 @@ instance Bits Word8 where
 "fromIntegral/Word8->a"       fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
   #-}
 
+{-# RULES
+"properFraction/Float->(Word8,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y) }
+"truncate/Float->Word8"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Word8) (truncate x)
+"floor/Float->Word8"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Word8) (floor x)
+"ceiling/Float->Word8"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Word8) (ceiling x)
+"round/Float->Word8"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Word8) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word8,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y) }
+"truncate/Double->Word8"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Word8) (truncate x)
+"floor/Double->Word8"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Word8) (floor x)
+"ceiling/Double->Word8"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Word8) (ceiling x)
+"round/Double->Word8"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Word8) (round x)
+  #-}
+
 ------------------------------------------------------------------------
 -- type Word16
 ------------------------------------------------------------------------
@@ -390,6 +425,36 @@ instance Bits Word16 where
 "fromIntegral/Word16->a"       fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
   #-}
 
+{-# RULES
+"properFraction/Float->(Word16,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y) }
+"truncate/Float->Word16"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Word16) (truncate x)
+"floor/Float->Word16"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Word16) (floor x)
+"ceiling/Float->Word16"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Word16) (ceiling x)
+"round/Float->Word16"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Word16) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word16,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y) }
+"truncate/Double->Word16"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Word16) (truncate x)
+"floor/Double->Word16"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Word16) (floor x)
+"ceiling/Double->Word16"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Word16) (ceiling x)
+"round/Double->Word16"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Word16) (round x)
+  #-}
+
 ------------------------------------------------------------------------
 -- type Word32
 ------------------------------------------------------------------------
@@ -495,6 +560,39 @@ instance Bits Word32 where
 #if WORD_SIZE_IN_BITS > 32
 -- Operations may assume and must ensure that it holds only values
 -- from its logical range.
+
+-- We can use rewrite rules for the RealFrac methods
+
+{-# RULES
+"properFraction/Float->(Word32,Float)"
+    forall x. properFraction (x :: Float) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y) }
+"truncate/Float->Word32"
+    forall x. truncate (x :: Float) = (fromIntegral :: Int -> Word32) (truncate x)
+"floor/Float->Word32"
+    forall x. floor    (x :: Float) = (fromIntegral :: Int -> Word32) (floor x)
+"ceiling/Float->Word32"
+    forall x. ceiling  (x :: Float) = (fromIntegral :: Int -> Word32) (ceiling x)
+"round/Float->Word32"
+    forall x. round    (x :: Float) = (fromIntegral :: Int -> Word32) (round x)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word32,Double)"
+    forall x. properFraction (x :: Double) =
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y) }
+"truncate/Double->Word32"
+    forall x. truncate (x :: Double) = (fromIntegral :: Int -> Word32) (truncate x)
+"floor/Double->Word32"
+    forall x. floor    (x :: Double) = (fromIntegral :: Int -> Word32) (floor x)
+"ceiling/Double->Word32"
+    forall x. ceiling  (x :: Double) = (fromIntegral :: Int -> Word32) (ceiling x)
+"round/Double->Word32"
+    forall x. round    (x :: Double) = (fromIntegral :: Int -> Word32) (round x)
+  #-}
+
 #endif
 
 data Word32 = W32# Word# deriving (Eq, Ord)