X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FInt.hs;h=03d488e6e0620baee63d5177a9e4acf0dde92c97;hb=ac0439db2ece671089cec9ade21754c3ad22c134;hp=ae49806e8683d8b499086c188a473692d61277f8;hpb=95087a4ef4877a0860331cac2eafab481158bd60;p=ghc-base.git

diff --git a/GHC/Int.hs b/GHC/Int.hs
index ae49806..03d488e 100644
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
@@ -40,6 +41,7 @@ import GHC.Arr
 import GHC.Err
 import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
 import GHC.Show
+import GHC.Float ()     -- for RealFrac methods
 
 ------------------------------------------------------------------------
 -- type Int8
@@ -142,21 +144,47 @@ instance Bits Int8 where
         = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                        (x'# `uncheckedShiftRL#` (8# -# i'#)))))
         where
-        x'# = narrow8Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
+        !x'# = narrow8Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
     bitSize  _                = 8
     isSigned _                = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
-
 {-# RULES
 "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
 "fromIntegral/a->Int8"    fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
 "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
 ------------------------------------------------------------------------
@@ -258,14 +286,11 @@ instance Bits Int16 where
         = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                          (x'# `uncheckedShiftRL#` (16# -# i'#)))))
         where
-        x'# = narrow16Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
+        !x'# = narrow16Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
     bitSize  _                 = 16
     isSigned _                 = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
 
 {-# RULES
 "fromIntegral/Word8->Int16"  fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
@@ -275,6 +300,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
 ------------------------------------------------------------------------
@@ -399,9 +454,6 @@ instance Bits Int32 where
     bitSize  _                 = 32
     isSigned _                 = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
 
 {-# RULES
 "fromIntegral/Int->Int32"    fromIntegral = \(I#   x#) -> I32# (intToInt32# x#)
@@ -413,7 +465,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
@@ -507,15 +560,11 @@ instance Bits Int32 where
         = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                          (x'# `uncheckedShiftRL#` (32# -# i'#)))))
         where
-        x'# = narrow32Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+        !x'# = narrow32Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
     bitSize  _                 = 32
     isSigned _                 = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
-
 {-# RULES
 "fromIntegral/Word8->Int32"  fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
 "fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
@@ -526,7 +575,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
@@ -634,7 +713,7 @@ x# `modInt64#` y#
         = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0#
     | otherwise = r#
     where
-    r# = x# `remInt64#` y#
+    !r# = x# `remInt64#` y#
 
 instance Read Int64 where
     readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
@@ -656,16 +735,11 @@ instance Bits Int64 where
         = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`
                                 (x'# `uncheckedShiftRL64#` (64# -# i'#))))
         where
-        x'# = int64ToWord64# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+        !x'# = int64ToWord64# x#
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                 = 64
     isSigned _                 = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
-
-
 -- give the 64-bit shift operations the same treatment as the 32-bit
 -- ones (see GHC.Base), namely we wrap them in tests to catch the
 -- cases when we're shifting more than 64 bits to avoid unspecified
@@ -691,7 +765,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
@@ -774,20 +850,46 @@ instance Bits Int64 where
         = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                            (x'# `uncheckedShiftRL#` (64# -# i'#))))
         where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+        !x'# = int2Word# x#
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                 = 64
     isSigned _                 = True
 
-    {-# INLINE shiftR #-}
-    -- same as the default definition, but we want it inlined (#2376)
-    x `shiftR`  i = x `shift`  (-i)
-
 {-# RULES
 "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
 "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#