Add instances for basic types of the new generic deriving mechanism.

[ghc-base.git] / GHC / Int.hs

diff --git a/GHC/Int.hs b/GHC/Int.hs
index b5e4b73..bafa7f0 100644 (file)
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, 
+             StandaloneDeriving #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -37,8 +38,12 @@ import GHC.Num
 import GHC.Real
 import GHC.Read
 import GHC.Arr
+import GHC.Err
 import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
 import GHC.Show
+import GHC.Float ()     -- for RealFrac methods
+-- For defining instances for the new generic deriving mechanism
+import GHC.Generics (Arity(..), Associativity(..), Fixity(..))
 
 ------------------------------------------------------------------------
 -- type Int8
@@ -117,9 +122,9 @@ instance Bounded Int8 where
     maxBound =  0x7F
 
 instance Ix Int8 where
-    range (m,n)              = [m..n]
-    unsafeIndex b@(m,_) i    = fromIntegral i - fromIntegral m
-    inRange (m,n) i          = m <= i && i <= n
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
 
 instance Read Int8 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -141,8 +146,8 @@ 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
 
@@ -152,6 +157,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
 ------------------------------------------------------------------------
@@ -229,9 +264,9 @@ instance Bounded Int16 where
     maxBound =  0x7FFF
 
 instance Ix Int16 where
-    range (m,n)              = [m..n]
-    unsafeIndex b@(m,_) i    = fromIntegral i - fromIntegral m
-    inRange (m,n) i          = m <= i && i <= n
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
 
 instance Read Int16 where
     readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
@@ -253,11 +288,12 @@ 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
 
+
 {-# RULES
 "fromIntegral/Word8->Int16"  fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
 "fromIntegral/Int8->Int16"   fromIntegral = \(I8# x#) -> I16# x#
@@ -266,6 +302,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
 ------------------------------------------------------------------------
@@ -390,6 +456,7 @@ instance Bits Int32 where
     bitSize  _                 = 32
     isSigned _                 = True
 
+
 {-# RULES
 "fromIntegral/Int->Int32"    fromIntegral = \(I#   x#) -> I32# (intToInt32# x#)
 "fromIntegral/Word->Int32"   fromIntegral = \(W#   x#) -> I32# (word32ToInt32# (wordToWord32# x#))
@@ -400,7 +467,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
@@ -494,8 +562,8 @@ 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
 
@@ -509,7 +577,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
@@ -519,9 +617,9 @@ instance Bounded Int32 where
     maxBound =  0x7FFFFFFF
 
 instance Ix Int32 where
-    range (m,n)              = [m..n]
-    unsafeIndex b@(m,_) i    = fromIntegral i - fromIntegral m
-    inRange (m,n) i          = m <= i && i <= n
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
 
 ------------------------------------------------------------------------
 -- type Int64
@@ -617,7 +715,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]
@@ -639,12 +737,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
 
-
 -- 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
@@ -670,7 +767,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
@@ -753,8 +852,8 @@ 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
 
@@ -763,7 +862,40 @@ 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#
+
+uncheckedIShiftRA64# :: Int# -> Int# -> Int#
 uncheckedIShiftRA64# = uncheckedIShiftRA#
 #endif
 
@@ -775,6 +907,29 @@ instance Bounded Int64 where
     maxBound =  0x7FFFFFFFFFFFFFFF
 
 instance Ix Int64 where
-    range (m,n)              = [m..n]
-    unsafeIndex b@(m,_) i    = fromIntegral i - fromIntegral m
-    inRange (m,n) i          = m <= i && i <= n
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
+
+------------------------------------------------------------------------
+-- Generic deriving
+------------------------------------------------------------------------
+
+-- We need instances for some basic datatypes, but some of those use Int,
+-- so we have to put the instances here
+
+deriving instance Eq Arity
+deriving instance Eq Associativity
+deriving instance Eq Fixity
+
+deriving instance Ord Arity
+deriving instance Ord Associativity
+deriving instance Ord Fixity
+
+deriving instance Read Arity
+deriving instance Read Associativity
+deriving instance Read Fixity
+
+deriving instance Show Arity
+deriving instance Show Associativity
+deriving instance Show Fixity