X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FInt.hs;h=bafa7f040f45b15d1294efd48c5f9ac99073abe0;hb=eb87007595377966ab5544f6e204e58a49deb3a9;hp=b5e4b73048815e28c55be85ee0a99ed8dadf72bb;hpb=10de2c656f74562b662c22928be85e1b3ccda796;p=ghc-base.git diff --git a/GHC/Int.hs b/GHC/Int.hs index b5e4b73..bafa7f0 100644 --- 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