```{-# LANGUAGE RebindableSyntax #-}

module Prelude.YAP.Internal (
module Prelude.YAP.Internal
) where

import Prelude hiding (
Num(..), Real(..), Integral(..), Fractional(..),
Floating(..), RealFrac(..), RealFloat(..),
subtract, even, odd, gcd, lcm, (^), (^^), fromIntegral, realToFrac)
import qualified Prelude
import Data.YAP.Algebra.Internal

infixr 8  ^, ^^, **
infixl 7  `quot`, `rem`

-- Numeric classes

-------------------------------------------------------------------------
-------------------------------------------------------------------------

-- all builtin numeric types, plus Ratio and Complex
-- | Haskell 98 compatibility class
class  (Eq a, Show a, Ring a) => Num a  where
-- | Absolute value.
abs                 :: a -> a
-- | Sign of a number.
-- The functions 'abs' and 'signum' should satisfy the law:
--
-- > abs x * signum x == x
--
-- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero)
-- or @1@ (positive).
signum              :: a -> a

-- | unchanged from Haskell 98
class  (Num a, Ord a) => Real a  where
-- | The rational equivalent of its real argument with full precision
toRational       ::  a -> Rational

-- | Integral numbers, supporting integer division.
--
-- Minimal complete definition: 'toInteger'.
class  (Real a, Enum a, EuclideanDomain a) => Integral a  where
-- | Integer division truncated toward zero
quot                :: a -> a -> a
-- | Integer remainder, satisfying
--
-- > (x `quot` y)*y + (x `rem` y) == x
rem                 :: a -> a -> a
-- | simultaneous 'quot' and 'rem'
quotRem          :: a -> a -> (a,a)
-- | Conversion to 'Integer'
toInteger        :: a -> Integer

-- Minimal complete definition:
--      toInteger
n `quot` d       =  q  where (q,_) = quotRem n d
n `rem` d        =  r  where (_,r) = quotRem n d
quotRem n d      =  if signum r == - signum d then (q+1, r-d) else qr
where qr@(q,r) = divMod n d

-- | Haskell 98 compatibility class
class  (Num a, Field a) => Fractional a  where
-- | Convert from 'Rational'
--
-- A floating point numeric literal represents the application of
-- the function 'fromRational' to the appropriate value of type
-- 'Rational', so such literals have type @('Field' a) => a@.
fromRational    :: Rational -> a

fromRational x   =  fromInteger (numerator x) /
fromInteger (denominator x)

-------------------------------------------------------------------------
-------------------------------------------------------------------------

-- | unchanged from Haskell 98
class  (Fractional a) => Floating a  where
pi                  :: a
exp, log, sqrt      :: a -> a
(**), logBase       :: a -> a -> a
sin, cos, tan       :: a -> a
asin, acos, atan    :: a -> a
sinh, cosh, tanh    :: a -> a
asinh, acosh, atanh :: a -> a

-- Minimal complete definition:
--      pi, exp, log, sin, cos, sinh, cosh
--      asin, acos, atan
--      asinh, acosh, atanh
x ** y           =  exp (log x * y)
logBase x y      =  log y / log x
sqrt x           =  x ** 0.5
tan  x           =  sin  x / cos  x
tanh x           =  sinh x / cosh x

-- | unchanged from Haskell 98
class  (Real a, Fractional a) => RealFrac a  where
properFraction   :: (Integral b) => a -> (b,a)
truncate, round  :: (Integral b) => a -> b
ceiling, floor   :: (Integral b) => a -> b

-- Minimal complete definition:
--      properFraction
truncate x       =  m  where (m,_) = properFraction x

round x          =  let (n,r) = properFraction x
m     = if r < 0 then n - 1 else n + 1
in case signum (abs r - 0.5) of
-1 -> n
0  -> if even n then n else m
1  -> m

ceiling x        =  if r > 0 then n + 1 else n
where (n,r) = properFraction x

floor x          =  if r < 0 then n - 1 else n
where (n,r) = properFraction x

-- | unchanged from Haskell 98
class  (RealFrac a, Floating a) => RealFloat a  where
floatDigits      :: a -> Int
floatRange       :: a -> (Int,Int)
decodeFloat      :: a -> (Integer,Int)
encodeFloat      :: Integer -> Int -> a
exponent         :: a -> Int
significand      :: a -> a
scaleFloat       :: Int -> a -> a
isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
:: a -> Bool
atan2            :: a -> a -> a

-- Minimal complete definition:
--      All except exponent, significand,
--                 scaleFloat, atan2
exponent x       =  if m == 0 then 0 else n + floatDigits x
where (m,n) = decodeFloat x

significand x    =  encodeFloat m (- floatDigits x)
where (m,_) = decodeFloat x

scaleFloat k x   =  encodeFloat m (n+k)
where (m,n) = decodeFloat x

atan2 y x
| x>0           =  atan (y/x)
| x==0 && y>0   =  pi/2
| x<0  && y>0   =  pi + atan (y/x)
|(x<=0 && y<0)  ||
(x<0 && isNegativeZero y) ||
(isNegativeZero x && isNegativeZero y)
= -atan2 (-y) x
| y==0 && (x<0 || isNegativeZero x)
=  pi    -- must be after the previous test on zero y
| x==0 && y==0  =  y     -- must be after the other double zero tests
| otherwise     =  x + y -- x or y is a NaN, return a NaN (via +)

-- Numeric functions

even, odd        :: (Integral a) => a -> Bool
even n           =  n `rem` 2 == 0
odd              =  not . even

-- | raise a number to a non-negative integral power
(^)              :: (Ring a, Integral b) => a -> b -> a
_ ^ 0            =  1
x ^ n | n > 0    =  f x (n-1) x
where f _ 0 y = y
f x n y = g x n  where
g x n | even n  = g (x*x) (n `quot` 2)
| otherwise = f x (n-1) (x*y)
_ ^ _            = error "Prelude.^: negative exponent"

-- | raise a number to an integral power
(^^)             :: (Field a, Integral b) => a -> b -> a
x ^^ n           =  if n >= 0 then x^n else recip (x^(-n))

-- | General conversion from integral types, via the 'Integer' type.
fromIntegral     :: (Integral a, Ring b) => a -> b
fromIntegral     =  fromInteger . toInteger

-- | General conversion to fields, via the 'Rational' type.
realToFrac      :: (Real a, Fractional b) => a -> b
realToFrac      =  fromRational . toRational

-------------------------------------------------------------------------
-- instances for Prelude numeric types
-------------------------------------------------------------------------

instance  Num Int  where
abs             =  Prelude.abs
signum          =  Prelude.signum

instance  Real Int  where
toRational x    =  toInteger x :% 1

instance  Integral Int  where
toInteger       =  Prelude.toInteger

instance  Num Integer  where
abs             =  Prelude.abs
signum          =  Prelude.signum

instance  Real Integer  where
toRational x    =  x :% 1

instance  Integral Integer  where
toInteger       =  id

instance  Num Float  where
abs             =  Prelude.abs
signum          =  Prelude.signum

instance  Real Float  where
toRational x    =  (m%1)*(b%1)^^n
where (m,n) = Prelude.decodeFloat x

instance  Fractional Float  where
fromRational    =  Prelude.fromRational

instance  Floating Float  where
pi              =  Prelude.pi
exp             =  Prelude.exp
log             =  Prelude.log
sin             =  Prelude.sin
cos             =  Prelude.cos
sinh            =  Prelude.sinh
cosh            =  Prelude.cosh
asin            =  Prelude.asin
acos            =  Prelude.acos
atan            =  Prelude.atan
asinh           =  Prelude.asinh
acosh           =  Prelude.acosh
atanh           =  Prelude.atanh

instance  RealFrac Float  where
properFraction x =  (fromInteger n, r)
where (n,r) = Prelude.properFraction x

instance  RealFloat Float  where
floatDigits     =  Prelude.floatDigits
floatRange      =  Prelude.floatRange
decodeFloat     =  Prelude.decodeFloat
encodeFloat     =  Prelude.encodeFloat
isNaN           =  Prelude.isNaN
isInfinite      =  Prelude.isInfinite
isDenormalized  =  Prelude.isDenormalized
isNegativeZero  =  Prelude.isNegativeZero
isIEEE          =  Prelude.isIEEE

instance  Num Double  where
abs             =  Prelude.abs
signum          =  Prelude.signum

instance  Real Double  where
toRational x    =  (m%1)*(b%1)^^n
where (m,n) = Prelude.decodeFloat x

instance  Fractional Double  where
fromRational    =  Prelude.fromRational

instance  Floating Double  where
pi              =  Prelude.pi
exp             =  Prelude.exp
log             =  Prelude.log
sin             =  Prelude.sin
cos             =  Prelude.cos
sinh            =  Prelude.sinh
cosh            =  Prelude.cosh
asin            =  Prelude.asin
acos            =  Prelude.acos
atan            =  Prelude.atan
asinh           =  Prelude.asinh
acosh           =  Prelude.acosh
atanh           =  Prelude.atanh

instance  RealFrac Double  where
properFraction x =  (fromInteger n, r)
where (n,r) = Prelude.properFraction x

instance  RealFloat Double  where
floatDigits     =  Prelude.floatDigits
floatRange      =  Prelude.floatRange
decodeFloat     =  Prelude.decodeFloat
encodeFloat     =  Prelude.encodeFloat
isNaN           =  Prelude.isNaN
isInfinite      =  Prelude.isInfinite
isDenormalized  =  Prelude.isDenormalized
isNegativeZero  =  Prelude.isNegativeZero
isIEEE          =  Prelude.isIEEE

-- Prelude.Integral a is required here to get Show (Ratio a)

instance  (Integral a, Prelude.Integral a)  => Num (Ratio a)  where
abs (x:%y)          =  abs x :% y
signum (x:%_)       =  signum x :% 1

instance  (Integral a, Prelude.Integral a)  => Real (Ratio a)  where
toRational (x:%y)   =  toInteger x :% toInteger y

instance  (Integral a, Prelude.Integral a)  => Fractional (Ratio a)  where
fromRational x      =  fromInteger (numerator x) :%
fromInteger (denominator x)

instance  (Integral a, Prelude.Integral a)  => RealFrac (Ratio a)  where
properFraction (x:%y) = (fromIntegral q, r:%y)
where (q,r) = quotRem x y
```