{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, BangPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Real where
#include "MachDeps.h"
import GHC.Base
import GHC.Num
import GHC.List
import GHC.Enum
import GHC.Show
import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException
, underflowException
, ratioZeroDenomException )
#if defined(MIN_VERSION_integer_gmp)
import GHC.Integer.GMP.Internals
#endif
infixr 8 ^, ^^
infixl 7 /, `quot`, `rem`, `div`, `mod`
infixl 7 %
default ()
{-# NOINLINE divZeroError #-}
divZeroError :: a
divZeroError :: a
divZeroError = SomeException -> a
forall b a. b -> a
raise# SomeException
divZeroException
{-# NOINLINE ratioZeroDenominatorError #-}
ratioZeroDenominatorError :: a
ratioZeroDenominatorError :: a
ratioZeroDenominatorError = SomeException -> a
forall b a. b -> a
raise# SomeException
ratioZeroDenomException
{-# NOINLINE overflowError #-}
overflowError :: a
overflowError :: a
overflowError = SomeException -> a
forall b a. b -> a
raise# SomeException
overflowException
{-# NOINLINE underflowError #-}
underflowError :: a
underflowError :: a
underflowError = SomeException -> a
forall b a. b -> a
raise# SomeException
underflowException
data Ratio a = !a :% !a deriving Eq
type Rational = Ratio Integer
ratioPrec, ratioPrec1 :: Int
ratioPrec :: Int
ratioPrec = 7
ratioPrec1 :: Int
ratioPrec1 = Int
ratioPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
infinity, notANumber :: Rational
infinity :: Rational
infinity = 1 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 0
notANumber :: Rational
notANumber = 0 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 0
{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
(%) :: (Integral a) => a -> a -> Ratio a
numerator :: Ratio a -> a
denominator :: Ratio a -> a
reduce :: (Integral a) => a -> a -> Ratio a
{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}
reduce :: a -> a -> Ratio a
reduce _ 0 = Ratio a
forall a. a
ratioZeroDenominatorError
reduce x :: a
x y :: a
y = (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
d)
where d :: a
d = a -> a -> a
forall a. Integral a => a -> a -> a
gcd a
x a
y
x :: a
x % :: a -> a -> Ratio a
% y :: a
y = a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
reduce (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
signum a
y) (a -> a
forall a. Num a => a -> a
abs a
y)
numerator :: Ratio a -> a
numerator (x :: a
x :% _) = a
x
denominator :: Ratio a -> a
denominator (_ :% y :: a
y) = a
y
class (Num a, Ord a) => Real a where
toRational :: a -> Rational
class (Real a, Enum a) => Integral a where
quot :: a -> a -> a
rem :: a -> a -> a
div :: a -> a -> a
mod :: a -> a -> a
quotRem :: a -> a -> (a,a)
divMod :: a -> a -> (a,a)
toInteger :: a -> Integer
{-# INLINE quot #-}
{-# INLINE rem #-}
{-# INLINE div #-}
{-# INLINE mod #-}
n :: a
n `quot` d :: a
d = a
q where (q :: a
q,_) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
n :: a
n `rem` d :: a
d = a
r where (_,r :: a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
n :: a
n `div` d :: a
d = a
q where (q :: a
q,_) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
n a
d
n :: a
n `mod` d :: a
d = a
r where (_,r :: a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
n a
d
divMod n :: a
n d :: a
d = if a -> a
forall a. Num a => a -> a
signum a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Num a => a -> a
negate (a -> a
forall a. Num a => a -> a
signum a
d) then (a
qa -> a -> a
forall a. Num a => a -> a -> a
-1, a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
d) else (a, a)
qr
where qr :: (a, a)
qr@(q :: a
q,r :: a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
class (Num a) => Fractional a where
{-# MINIMAL fromRational, (recip | (/)) #-}
(/) :: a -> a -> a
recip :: a -> a
fromRational :: Rational -> a
{-# INLINE recip #-}
{-# INLINE (/) #-}
recip x :: a
x = 1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
x
x :: a
x / y :: a
y = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Fractional a => a -> a
recip a
y
class (Real a, Fractional a) => RealFrac a where
properFraction :: (Integral b) => a -> (b,a)
truncate :: (Integral b) => a -> b
round :: (Integral b) => a -> b
ceiling :: (Integral b) => a -> b
floor :: (Integral b) => a -> b
{-# INLINE truncate #-}
truncate x :: a
x = b
m where (m :: b
m,_) = a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
round x :: a
x = let (n :: b
n,r :: a
r) = a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
m :: b
m = if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1
in case a -> a
forall a. Num a => a -> a
signum (a -> a
forall a. Num a => a -> a
abs a
r a -> a -> a
forall a. Num a => a -> a -> a
- 0.5) of
-1 -> b
n
0 -> if b -> Bool
forall a. Integral a => a -> Bool
even b
n then b
n else b
m
1 -> b
m
_ -> [Char] -> b
forall a. [Char] -> a
errorWithoutStackTrace "round default defn: Bad value"
ceiling x :: a
x = if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1 else b
n
where (n :: b
n,r :: a
r) = a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
floor x :: a
x = if a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n
where (n :: b
n,r :: a
r) = a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
numericEnumFrom :: (Fractional a) => a -> [a]
numericEnumFrom :: a -> [a]
numericEnumFrom n :: a
n = a -> [a]
go 0
where
go :: a -> [a]
go !a
k = let !n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
k
in a
n' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
k a -> a -> a
forall a. Num a => a -> a -> a
+ 1)
numericEnumFromThen :: (Fractional a) => a -> a -> [a]
numericEnumFromThen :: a -> a -> [a]
numericEnumFromThen n :: a
n m :: a
m = a -> [a]
go 0
where
step :: a
step = a
m a -> a -> a
forall a. Num a => a -> a -> a
- a
n
go :: a -> [a]
go !a
k = let !n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
step
in a
n' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a
k a -> a -> a
forall a. Num a => a -> a -> a
+ 1)
numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo :: a -> a -> [a]
numericEnumFromTo n :: a
n m :: a
m = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
m a -> a -> a
forall a. Num a => a -> a -> a
+ 1a -> a -> a
forall a. Fractional a => a -> a -> a
/2) (a -> [a]
forall a. Fractional a => a -> [a]
numericEnumFrom a
n)
numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a]
numericEnumFromThenTo :: a -> a -> a -> [a]
numericEnumFromThenTo e1 :: a
e1 e2 :: a
e2 e3 :: a
e3
= (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
predicate (a -> a -> [a]
forall a. Fractional a => a -> a -> [a]
numericEnumFromThen a
e1 a
e2)
where
mid :: a
mid = (a
e2 a -> a -> a
forall a. Num a => a -> a -> a
- a
e1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ 2
predicate :: a -> Bool
predicate | a
e2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
e1 = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
e3 a -> a -> a
forall a. Num a => a -> a -> a
+ a
mid)
| Bool
otherwise = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
e3 a -> a -> a
forall a. Num a => a -> a -> a
+ a
mid)
instance Real Int where
toRational :: Int -> Rational
toRational x :: Int
x = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
x Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
instance Integral Int where
toInteger :: Int -> Integer
toInteger (I# i :: Int#
i) = Int# -> Integer
smallInteger Int#
i
a :: Int
a quot :: Int -> Int -> Int
`quot` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = Int
forall a. a
overflowError
| Bool
otherwise = Int
a Int -> Int -> Int
`quotInt` Int
b
a :: Int
a rem :: Int -> Int -> Int
`rem` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) = 0
| Bool
otherwise = Int
a Int -> Int -> Int
`remInt` Int
b
a :: Int
a div :: Int -> Int -> Int
`div` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = Int
forall a. a
overflowError
| Bool
otherwise = Int
a Int -> Int -> Int
`divInt` Int
b
a :: Int
a mod :: Int -> Int -> Int
`mod` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) = 0
| Bool
otherwise = Int
a Int -> Int -> Int
`modInt` Int
b
a :: Int
a quotRem :: Int -> Int -> (Int, Int)
`quotRem` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Int, Int)
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = (Int
forall a. a
overflowError, 0)
| Bool
otherwise = Int
a Int -> Int -> (Int, Int)
`quotRemInt` Int
b
a :: Int
a divMod :: Int -> Int -> (Int, Int)
`divMod` b :: Int
b
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Int, Int)
forall a. a
divZeroError
| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-1) Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = (Int
forall a. a
overflowError, 0)
| Bool
otherwise = Int
a Int -> Int -> (Int, Int)
`divModInt` Int
b
instance Real Word where
toRational :: Word -> Rational
toRational x :: Word
x = Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 1
instance Integral Word where
quot :: Word -> Word -> Word
quot (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`quotWord#` Word#
y#)
| Bool
otherwise = Word
forall a. a
divZeroError
rem :: Word -> Word -> Word
rem (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`remWord#` Word#
y#)
| Bool
otherwise = Word
forall a. a
divZeroError
div :: Word -> Word -> Word
div (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`quotWord#` Word#
y#)
| Bool
otherwise = Word
forall a. a
divZeroError
mod :: Word -> Word -> Word
mod (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`remWord#` Word#
y#)
| Bool
otherwise = Word
forall a. a
divZeroError
quotRem :: Word -> Word -> (Word, Word)
quotRem (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = case Word#
x# Word# -> Word# -> (# Word#, Word# #)
`quotRemWord#` Word#
y# of
(# q :: Word#
q, r :: Word#
r #) ->
(Word# -> Word
W# Word#
q, Word# -> Word
W# Word#
r)
| Bool
otherwise = (Word, Word)
forall a. a
divZeroError
divMod :: Word -> Word -> (Word, Word)
divMod (W# x# :: Word#
x#) y :: Word
y@(W# y# :: Word#
y#)
| Word
y Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = (Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`quotWord#` Word#
y#), Word# -> Word
W# (Word#
x# Word# -> Word# -> Word#
`remWord#` Word#
y#))
| Bool
otherwise = (Word, Word)
forall a. a
divZeroError
toInteger :: Word -> Integer
toInteger (W# x# :: Word#
x#) = Word# -> Integer
wordToInteger Word#
x#
instance Real Integer where
toRational :: Integer -> Rational
toRational x :: Integer
x = Integer
x Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
instance Real Natural where
toRational :: Natural -> Rational
toRational n :: Natural
n = Natural -> Integer
naturalToInteger Natural
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
instance Integral Integer where
toInteger :: Integer -> Integer
toInteger n :: Integer
n = Integer
n
{-# INLINE quot #-}
_ quot :: Integer -> Integer -> Integer
`quot` 0 = Integer
forall a. a
divZeroError
n :: Integer
n `quot` d :: Integer
d = Integer
n Integer -> Integer -> Integer
`quotInteger` Integer
d
{-# INLINE rem #-}
_ rem :: Integer -> Integer -> Integer
`rem` 0 = Integer
forall a. a
divZeroError
n :: Integer
n `rem` d :: Integer
d = Integer
n Integer -> Integer -> Integer
`remInteger` Integer
d
{-# INLINE div #-}
_ div :: Integer -> Integer -> Integer
`div` 0 = Integer
forall a. a
divZeroError
n :: Integer
n `div` d :: Integer
d = Integer
n Integer -> Integer -> Integer
`divInteger` Integer
d
{-# INLINE mod #-}
_ mod :: Integer -> Integer -> Integer
`mod` 0 = Integer
forall a. a
divZeroError
n :: Integer
n `mod` d :: Integer
d = Integer
n Integer -> Integer -> Integer
`modInteger` Integer
d
{-# INLINE divMod #-}
_ divMod :: Integer -> Integer -> (Integer, Integer)
`divMod` 0 = (Integer, Integer)
forall a. a
divZeroError
n :: Integer
n `divMod` d :: Integer
d = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`divModInteger` Integer
d of
(# x :: Integer
x, y :: Integer
y #) -> (Integer
x, Integer
y)
{-# INLINE quotRem #-}
_ quotRem :: Integer -> Integer -> (Integer, Integer)
`quotRem` 0 = (Integer, Integer)
forall a. a
divZeroError
n :: Integer
n `quotRem` d :: Integer
d = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
d of
(# q :: Integer
q, r :: Integer
r #) -> (Integer
q, Integer
r)
instance Integral Natural where
toInteger :: Natural -> Integer
toInteger = Natural -> Integer
naturalToInteger
divMod :: Natural -> Natural -> (Natural, Natural)
divMod = Natural -> Natural -> (Natural, Natural)
quotRemNatural
div :: Natural -> Natural -> Natural
div = Natural -> Natural -> Natural
quotNatural
mod :: Natural -> Natural -> Natural
mod = Natural -> Natural -> Natural
remNatural
quotRem :: Natural -> Natural -> (Natural, Natural)
quotRem = Natural -> Natural -> (Natural, Natural)
quotRemNatural
quot :: Natural -> Natural -> Natural
quot = Natural -> Natural -> Natural
quotNatural
rem :: Natural -> Natural -> Natural
rem = Natural -> Natural -> Natural
remNatural
instance (Integral a) => Ord (Ratio a) where
{-# SPECIALIZE instance Ord Rational #-}
(x :: a
x:%y :: a
y) <= :: Ratio a -> Ratio a -> Bool
<= (x' :: a
x':%y' :: a
y') = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x' a -> a -> a
forall a. Num a => a -> a -> a
* a
y
(x :: a
x:%y :: a
y) < :: Ratio a -> Ratio a -> Bool
< (x' :: a
x':%y' :: a
y') = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x' a -> a -> a
forall a. Num a => a -> a -> a
* a
y
instance (Integral a) => Num (Ratio a) where
{-# SPECIALIZE instance Num Rational #-}
(x :: a
x:%y :: a
y) + :: Ratio a -> Ratio a -> Ratio a
+ (x' :: a
x':%y' :: a
y') = a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
reduce (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y' a -> a -> a
forall a. Num a => a -> a -> a
+ a
x'a -> a -> a
forall a. Num a => a -> a -> a
*a
y) (a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
y')
(x :: a
x:%y :: a
y) - :: Ratio a -> Ratio a -> Ratio a
- (x' :: a
x':%y' :: a
y') = a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
reduce (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y' a -> a -> a
forall a. Num a => a -> a -> a
- a
x'a -> a -> a
forall a. Num a => a -> a -> a
*a
y) (a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
y')
(x :: a
x:%y :: a
y) * :: Ratio a -> Ratio a -> Ratio a
* (x' :: a
x':%y' :: a
y') = a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
reduce (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x') (a
y a -> a -> a
forall a. Num a => a -> a -> a
* a
y')
negate :: Ratio a -> Ratio a
negate (x :: a
x:%y :: a
y) = (-a
x) a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y
abs :: Ratio a -> Ratio a
abs (x :: a
x:%y :: a
y) = a -> a
forall a. Num a => a -> a
abs a
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
y
signum :: Ratio a -> Ratio a
signum (x :: a
x:%_) = a -> a
forall a. Num a => a -> a
signum a
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% 1
fromInteger :: Integer -> Ratio a
fromInteger x :: Integer
x = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% 1
{-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
instance (Integral a) => Fractional (Ratio a) where
{-# SPECIALIZE instance Fractional Rational #-}
(x :: a
x:%y :: a
y) / :: Ratio a -> Ratio a -> Ratio a
/ (x' :: a
x':%y' :: a
y') = (a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
y') a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% (a
ya -> a -> a
forall a. Num a => a -> a -> a
*a
x')
recip :: Ratio a -> Ratio a
recip (0:%_) = Ratio a
forall a. a
ratioZeroDenominatorError
recip (x :: a
x:%y :: a
y)
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = a -> a
forall a. Num a => a -> a
negate a
y a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a -> a
forall a. Num a => a -> a
negate a
x
| Bool
otherwise = a
y a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% a
x
fromRational :: Rational -> Ratio a
fromRational (x :: Integer
x:%y :: Integer
y) = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
y
instance (Integral a) => Real (Ratio a) where
{-# SPECIALIZE instance Real Rational #-}
toRational :: Ratio a -> Rational
toRational (x :: a
x:%y :: a
y) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% a -> Integer
forall a. Integral a => a -> Integer
toInteger a
y
instance (Integral a) => RealFrac (Ratio a) where
{-# SPECIALIZE instance RealFrac Rational #-}
properFraction :: Ratio a -> (b, Ratio a)
properFraction (x :: a
x:%y :: a
y) = (Integer -> b
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
q), a
ra -> a -> Ratio a
forall a. a -> a -> Ratio a
:%a
y)
where (q :: a
q,r :: a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
x a
y
instance (Show a) => Show (Ratio a) where
{-# SPECIALIZE instance Show Rational #-}
showsPrec :: Int -> Ratio a -> ShowS
showsPrec p :: Int
p (x :: a
x:%y :: a
y) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ratioPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
ratioPrec1 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> ShowS
showString " % " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
ratioPrec1 a
y
instance (Integral a) => Enum (Ratio a) where
{-# SPECIALIZE instance Enum Rational #-}
succ :: Ratio a -> Ratio a
succ x :: Ratio a
x = Ratio a
x Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
+ 1
pred :: Ratio a -> Ratio a
pred x :: Ratio a
x = Ratio a
x Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
- 1
toEnum :: Int -> Ratio a
toEnum n :: Int
n = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n a -> a -> Ratio a
forall a. a -> a -> Ratio a
:% 1
fromEnum :: Ratio a -> Int
fromEnum = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Ratio a -> Integer) -> Ratio a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
enumFrom :: Ratio a -> [Ratio a]
enumFrom = Ratio a -> [Ratio a]
forall a. Fractional a => a -> [a]
numericEnumFrom
enumFromThen :: Ratio a -> Ratio a -> [Ratio a]
enumFromThen = Ratio a -> Ratio a -> [Ratio a]
forall a. Fractional a => a -> a -> [a]
numericEnumFromThen
enumFromTo :: Ratio a -> Ratio a -> [Ratio a]
enumFromTo = Ratio a -> Ratio a -> [Ratio a]
forall a. (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo
enumFromThenTo :: Ratio a -> Ratio a -> Ratio a -> [Ratio a]
enumFromThenTo = Ratio a -> Ratio a -> Ratio a -> [Ratio a]
forall a. (Ord a, Fractional a) => a -> a -> a -> [a]
numericEnumFromThenTo
{-# NOINLINE [1] fromIntegral #-}
fromIntegral :: (Integral a, Num b) => a -> b
fromIntegral :: a -> b
fromIntegral = Integer -> b
forall a. Num a => Integer -> a
fromInteger (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger
{-# RULES
"fromIntegral/Int->Int" fromIntegral = id :: Int -> Int
#-}
{-# RULES
"fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#)
"fromIntegral/Word->Int" fromIntegral = \(W# x#) -> I# (word2Int# x#)
"fromIntegral/Word->Word" fromIntegral = id :: Word -> Word
#-}
{-# RULES
"fromIntegral/Natural->Natural" fromIntegral = id :: Natural -> Natural
"fromIntegral/Natural->Integer" fromIntegral = toInteger :: Natural->Integer
"fromIntegral/Natural->Word" fromIntegral = naturalToWord
#-}
{-# RULES
"fromIntegral/Word->Natural" fromIntegral = wordToNatural
"fromIntegral/Int->Natural" fromIntegral = intToNatural
#-}
realToFrac :: (Real a, Fractional b) => a -> b
{-# NOINLINE [1] realToFrac #-}
realToFrac :: a -> b
realToFrac = Rational -> b
forall a. Fractional a => Rational -> a
fromRational (Rational -> b) -> (a -> Rational) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rational
forall a. Real a => a -> Rational
toRational
showSigned :: (Real a)
=> (a -> ShowS)
-> Int
-> a
-> ShowS
showSigned :: (a -> ShowS) -> Int -> a -> ShowS
showSigned showPos :: a -> ShowS
showPos p :: Int
p x :: a
x
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 6) (Char -> ShowS
showChar '-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showPos (-a
x))
| Bool
otherwise = a -> ShowS
showPos a
x
even, odd :: (Integral a) => a -> Bool
even :: a -> Bool
even n :: a
n = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` 2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0
odd :: a -> Bool
odd = Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. Integral a => a -> Bool
even
{-# INLINABLE even #-}
{-# INLINABLE odd #-}
{-# SPECIALISE [1] (^) ::
Integer -> Integer -> Integer,
Integer -> Int -> Integer,
Int -> Int -> Int #-}
{-# INLINABLE [1] (^) #-}
(^) :: (Num a, Integral b) => a -> b -> a
x0 :: a
x0 ^ :: a -> b -> a
^ y0 :: b
y0 | b
y0 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "Negative exponent"
| b
y0 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 1
| Bool
otherwise = a -> b -> a
forall a a. (Integral a, Num a) => a -> a -> a
f a
x0 b
y0
where
f :: a -> a -> a
f x :: a
x y :: a
y | a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a
f (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2)
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x
| Bool
otherwise = a -> a -> a -> a
forall a a. (Integral a, Num a) => a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
x
g :: a -> a -> a -> a
g x :: a
x y :: a
y z :: a
z | a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
z
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
z
| Bool
otherwise = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
z)
(^^) :: (Fractional a, Integral b) => a -> b -> a
{-# INLINABLE [1] (^^) #-}
x :: a
x ^^ :: a -> b -> a
^^ n :: b
n = if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then a
xa -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^b
n else a -> a
forall a. Fractional a => a -> a
recip (a
xa -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(b -> b
forall a. Num a => a -> a
negate b
n))
{-# RULES
"^2/Int" forall x. x ^ (2 :: Int) = let u = x in u*u
"^3/Int" forall x. x ^ (3 :: Int) = let u = x in u*u*u
"^4/Int" forall x. x ^ (4 :: Int) = let u = x in u*u*u*u
"^5/Int" forall x. x ^ (5 :: Int) = let u = x in u*u*u*u*u
"^2/Integer" forall x. x ^ (2 :: Integer) = let u = x in u*u
"^3/Integer" forall x. x ^ (3 :: Integer) = let u = x in u*u*u
"^4/Integer" forall x. x ^ (4 :: Integer) = let u = x in u*u*u*u
"^5/Integer" forall x. x ^ (5 :: Integer) = let u = x in u*u*u*u*u
#-}
{-# RULES "(^)/Rational" (^) = (^%^) #-}
(^%^) :: Integral a => Rational -> a -> Rational
(n :: Integer
n :% d :: Integer
d) ^%^ :: Rational -> a -> Rational
^%^ e :: a
e
| a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> Rational
forall a. [Char] -> a
errorWithoutStackTrace "Negative exponent"
| a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 1 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
| Bool
otherwise = (Integer
n Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a
e) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
d Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a
e)
{-# RULES "(^^)/Rational" (^^) = (^^%^^) #-}
(^^%^^) :: Integral a => Rational -> a -> Rational
(n :: Integer
n :% d :: Integer
d) ^^%^^ :: Rational -> a -> Rational
^^%^^ e :: a
e
| a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = (Integer
n Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a
e) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
d Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a
e)
| a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 1 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = (Integer
d Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (a -> a
forall a. Num a => a -> a
negate a
e)) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
n Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (a -> a
forall a. Num a => a -> a
negate a
e))
| Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Rational
forall a. a
ratioZeroDenominatorError
| Bool
otherwise = let nn :: Integer
nn = Integer
d Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (a -> a
forall a. Num a => a -> a
negate a
e)
dd :: Integer
dd = (Integer -> Integer
forall a. Num a => a -> a
negate Integer
n) Integer -> a -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (a -> a
forall a. Num a => a -> a
negate a
e)
in if a -> Bool
forall a. Integral a => a -> Bool
even a
e then (Integer
nn Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
dd) else (Integer -> Integer
forall a. Num a => a -> a
negate Integer
nn Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
dd)
gcd :: (Integral a) => a -> a -> a
{-# NOINLINE [1] gcd #-}
gcd :: a -> a -> a
gcd x :: a
x y :: a
y = a -> a -> a
forall a. Integral a => a -> a -> a
gcd' (a -> a
forall a. Num a => a -> a
abs a
x) (a -> a
forall a. Num a => a -> a
abs a
y)
where gcd' :: t -> t -> t
gcd' a :: t
a 0 = t
a
gcd' a :: t
a b :: t
b = t -> t -> t
gcd' t
b (t
a t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
b)
lcm :: (Integral a) => a -> a -> a
{-# SPECIALISE lcm :: Int -> Int -> Int #-}
{-# SPECIALISE lcm :: Word -> Word -> Word #-}
{-# NOINLINE [1] lcm #-}
lcm :: a -> a -> a
lcm _ 0 = 0
lcm 0 _ = 0
lcm x :: a
x y :: a
y = a -> a
forall a. Num a => a -> a
abs ((a
x a -> a -> a
forall a. Integral a => a -> a -> a
`quot` (a -> a -> a
forall a. Integral a => a -> a -> a
gcd a
x a
y)) a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
{-# RULES
"gcd/Integer->Integer->Integer" gcd = gcdInteger
"lcm/Integer->Integer->Integer" lcm = lcmInteger
"gcd/Natural->Natural->Natural" gcd = gcdNatural
"lcm/Natural->Natural->Natural" lcm = lcmNatural
#-}
#if defined(MIN_VERSION_integer_gmp)
gcdInt' :: Int -> Int -> Int
gcdInt' :: Int -> Int -> Int
gcdInt' (I# x :: Int#
x) (I# y :: Int#
y) = Int# -> Int
I# (Int# -> Int# -> Int#
gcdInt Int#
x Int#
y)
gcdWord' :: Word -> Word -> Word
gcdWord' :: Word -> Word -> Word
gcdWord' (W# x :: Word#
x) (W# y :: Word#
y) = Word# -> Word
W# (Word# -> Word# -> Word#
gcdWord Word#
x Word#
y)
{-# RULES
"gcd/Int->Int->Int" gcd = gcdInt'
"gcd/Word->Word->Word" gcd = gcdWord'
#-}
#endif
integralEnumFrom :: (Integral a, Bounded a) => a -> [a]
integralEnumFrom :: a -> [a]
integralEnumFrom n :: a
n = (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> a
forall a. Num a => Integer -> a
fromInteger [a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n .. a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n)]
integralEnumFromThen :: (Integral a, Bounded a) => a -> a -> [a]
integralEnumFromThen :: a -> a -> [a]
integralEnumFromThen n1 :: a
n1 n2 :: a
n2
| Integer
i_n2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i_n1 = (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> a
forall a. Num a => Integer -> a
fromInteger [Integer
i_n1, Integer
i_n2 .. a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n1)]
| Bool
otherwise = (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> a
forall a. Num a => Integer -> a
fromInteger [Integer
i_n1, Integer
i_n2 .. a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
n1)]
where
i_n1 :: Integer
i_n1 = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n1
i_n2 :: Integer
i_n2 = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n2
integralEnumFromTo :: Integral a => a -> a -> [a]
integralEnumFromTo :: a -> a -> [a]
integralEnumFromTo n :: a
n m :: a
m = (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> a
forall a. Num a => Integer -> a
fromInteger [a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n .. a -> Integer
forall a. Integral a => a -> Integer
toInteger a
m]
integralEnumFromThenTo :: Integral a => a -> a -> a -> [a]
integralEnumFromThenTo :: a -> a -> a -> [a]
integralEnumFromThenTo n1 :: a
n1 n2 :: a
n2 m :: a
m
= (Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> a
forall a. Num a => Integer -> a
fromInteger [a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n1, a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n2 .. a -> Integer
forall a. Integral a => a -> Integer
toInteger a
m]