diff options
Diffstat (limited to 'libraries/ghc-bignum/src')
-rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs | 61 |
1 files changed, 40 insertions, 21 deletions
diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs index 870ac745ea..2e0327127d 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs @@ -225,6 +225,17 @@ integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x +-- | Convert a Integer into a Natural +-- +-- Throw on underflow +integerToNaturalThrow :: Integer -> Natural +{-# NOINLINE integerToNaturalThrow #-} +integerToNaturalThrow (IS x) + | isTrue# (x <# 0#) = raiseUnderflow + | True = naturalFromWord# (int2Word# x) +integerToNaturalThrow (IP x) = naturalFromBigNat# x +integerToNaturalThrow (IN _) = raiseUnderflow + --------------------------------------------------------------------- -- Predicates --------------------------------------------------------------------- @@ -292,30 +303,30 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# {-# NOINLINE integerGt# #-} -integerGt# (IS x) (IS y) = x ># y -integerGt# x y | GT <- integerCompare x y = 1# -integerGt# _ _ = 0# +integerGt# (IS x) (IS y) = x ># y +integerGt# x y | GT <- integerCompare' x y = 1# +integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# {-# NOINLINE integerLe# #-} -integerLe# (IS x) (IS y) = x <=# y -integerLe# x y | GT <- integerCompare x y = 0# -integerLe# _ _ = 1# +integerLe# (IS x) (IS y) = x <=# y +integerLe# x y | GT <- integerCompare' x y = 0# +integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# {-# NOINLINE integerLt# #-} -integerLt# (IS x) (IS y) = x <# y -integerLt# x y | LT <- integerCompare x y = 1# -integerLt# _ _ = 0# +integerLt# (IS x) (IS y) = x <# y +integerLt# x y | LT <- integerCompare' x y = 1# +integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# {-# NOINLINE integerGe# #-} -integerGe# (IS x) (IS y) = x >=# y -integerGe# x y | LT <- integerCompare x y = 0# -integerGe# _ _ = 1# +integerGe# (IS x) (IS y) = x >=# y +integerGe# x y | LT <- integerCompare' x y = 0# +integerGe# _ _ = 1# instance Eq Integer where (==) = integerEq @@ -324,18 +335,26 @@ instance Eq Integer where -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering {-# NOINLINE integerCompare #-} -integerCompare (IS x) (IS y) = compareInt# x y -integerCompare (IP x) (IP y) = bigNatCompare x y -integerCompare (IN x) (IN y) = bigNatCompare y x -integerCompare (IS _) (IP _) = LT -integerCompare (IS _) (IN _) = GT -integerCompare (IP _) (IS _) = GT -integerCompare (IN _) (IS _) = LT -integerCompare (IP _) (IN _) = GT -integerCompare (IN _) (IP _) = LT +integerCompare = integerCompare' + +integerCompare' :: Integer -> Integer -> Ordering +{-# INLINE integerCompare' #-} +integerCompare' (IS x) (IS y) = compareInt# x y +integerCompare' (IP x) (IP y) = bigNatCompare x y +integerCompare' (IN x) (IN y) = bigNatCompare y x +integerCompare' (IS _) (IP _) = LT +integerCompare' (IS _) (IN _) = GT +integerCompare' (IP _) (IS _) = GT +integerCompare' (IN _) (IS _) = LT +integerCompare' (IP _) (IN _) = GT +integerCompare' (IN _) (IP _) = LT instance Ord Integer where compare = integerCompare + (<) = integerLt + (<=) = integerLe + (>) = integerGt + (>=) = integerGe --------------------------------------------------------------------- -- Operations |