ghc/lib/prelude/IRatio.hs

   1 --*** All of PreludeRatio, except the actual data/type decls.
   2 --*** data Ratio ... is builtin (no need to import TyRatio)
   3
   4 module PreludeRatio where
   5
   6 import Cls
   7 import Core
   8 import IChar
   9 import IDouble
  10 import IFloat
  11 import IInt
  12 import IInteger
  13 import IList
  14 import List             ( iterate, (++), foldr, takeWhile )
  15 import Prel             ( (&&), (||), (.), otherwise, gcd, fromIntegral, id )
  16 import PS               ( _PackedString, _unpackPS )
  17 import Text
  18 import TyArray
  19 import TyComplex
  20
  21 --infixl 7  %, :%
  22
  23 prec = (7 :: Int)
  24
  25 {-# GENERATE_SPECS (%) a{Integer} #-}
  26 (%)             :: (Integral a) => a -> a -> Ratio a
  27
  28 numerator :: Ratio a -> a
  29 numerator (x:%y)        =  x
  30
  31 denominator :: Ratio a -> a
  32 denominator (x:%y)      =  y
  33
  34
  35 x % y                   =  reduce (x * signum y) (abs y)
  36
  37 reduce x y | y == __i0  =  error "(%){PreludeRatio}: zero denominator\n"
  38            | otherwise  =  (x `quot` d) :% (y `quot` d)
  39                            where d = gcd x y
  40
  41 instance (Integral a) => Eq (Ratio a) where
  42     {- works because Ratios held in reduced form -}
  43     (x :% y) == (x2 :% y2)  =  x == x2 && y == y2
  44     (x :% y) /= (x2 :% y2)  =  x /= x2 || y /= y2
  45
  46 instance (Integral a) => Ord (Ratio a) where
  47     (x1:%y1) <= (x2:%y2) =  x1 * y2 <= x2 * y1
  48     (x1:%y1) <  (x2:%y2) =  x1 * y2 <  x2 * y1
  49     (x1:%y1) >= (x2:%y2) =  x1 * y2 >= x2 * y1
  50     (x1:%y1) >  (x2:%y2) =  x1 * y2 >  x2 * y1
  51     min x y | x <= y    = x
  52     min x y | otherwise = y
  53     max x y | x >= y    = x
  54     max x y | otherwise = y
  55     _tagCmp (x1:%y1) (x2:%y2)
  56       = if x1y2 == x2y1 then _EQ else if x1y2 < x2y1 then _LT else _GT
  57       where x1y2 = x1 * y2
  58             x2y1 = x2 * y1
  59
  60 instance (Integral a) => Num (Ratio a) where
  61     (x1:%y1) + (x2:%y2) =  reduce (x1*y2 + x2*y1) (y1*y2)
  62     (x1:%y1) - (x2:%y2) =  reduce (x1*y2 - x2*y1) (y1*y2)
  63     (x1:%y1) * (x2:%y2) =  reduce (x1 * x2) (y1 * y2)
  64     negate (x:%y)       =  (-x) :% y
  65     abs (x:%y)          =  abs x :% y
  66     signum (x:%y)       =  signum x :% __i1
  67     fromInteger x       =  fromInteger x :% __i1
  68     fromInt x           =  fromInt x :% __i1
  69
  70 instance (Integral a) => Real (Ratio a) where
  71     toRational (x:%y)   =  toInteger x :% toInteger y
  72
  73 instance (Integral a) => Fractional (Ratio a) where
  74     (x1:%y1) / (x2:%y2) =  (x1*y2) % (y1*x2)
  75     recip (x:%y)        =  if x < __i0 then (-y) :% (-x) else y :% x
  76     fromRational (x:%y) =  fromInteger x :% fromInteger y
  77
  78
  79 instance (Integral a) => Enum (Ratio a) where
  80     enumFrom             =  iterate ((+) __i1)
  81     enumFromThen n m     =  iterate ((+) (m-n)) n
  82     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
  83     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
  84                                       (enumFromThen n m)
  85
  86 instance  (Integral a) => Text (Ratio a)  where
  87     readsPrec p  =  readParen (p > prec)
  88                               (\r -> [(x%y,u) | (x,s)   <- readsPrec 0 r,
  89                                                 ("%",t) <- lex s,
  90                                                 (y,u)   <- readsPrec 0 t ])
  91
  92     showsPrec p (x:%y)  =  showParen (p > prec)
  93                                (showsPrec 0 x . showString " % " . showsPrec 0 y)
  94
  95     readList    = _readList (readsPrec 0)
  96     showList    = _showList (showsPrec 0)
  97
  98 {-# SPECIALIZE instance Eq          (Ratio Integer) #-}
  99 {-# SPECIALIZE instance Ord         (Ratio Integer) #-}
 100 {-# SPECIALIZE instance Num         (Ratio Integer) #-}
 101 {-# SPECIALIZE instance Real        (Ratio Integer) #-}
 102 {-# SPECIALIZE instance Fractional  (Ratio Integer) #-}
 103 {-# SPECIALIZE instance Enum        (Ratio Integer) #-}
 104 {-# SPECIALIZE instance Text        (Ratio Integer) #-}
 105
 106 -- We have to give a real overlapped instance for RealFrac (Ratio Integer)
 107 -- since we need to give SPECIALIZE pragmas
 108
 109 -- ToDo: Allow (ignored) SPEC pragmas in poly instance]
 110 --       and substitute for tyvars in a SPECIALIZED instance
 111
 112 instance RealFrac (Ratio Integer) where
 113
 114     {-# SPECIALIZE properFraction :: Rational -> (Int, Rational) #-}
 115     {-# SPECIALIZE truncate :: Rational -> Int #-}
 116     {-# SPECIALIZE round    :: Rational -> Int #-}
 117     {-# SPECIALIZE ceiling  :: Rational -> Int #-}
 118     {-# SPECIALIZE floor    :: Rational -> Int #-}
 119
 120     {-# SPECIALIZE properFraction :: Rational -> (Integer, Rational) #-}
 121     {-# SPECIALIZE truncate :: Rational -> Integer #-}
 122     {-# SPECIALIZE round    :: Rational -> Integer #-}
 123     {-# SPECIALIZE ceiling  :: Rational -> Integer #-}
 124     {-# SPECIALIZE floor    :: Rational -> Integer #-}
 125
 126     properFraction (x:%y) = case quotRem x y of
 127                               (q,r) -> (fromIntegral q, r:%y)
 128
 129     truncate x  = case properFraction x of
 130                      (n,_) -> n
 131
 132     round x     = case properFraction x of
 133                      (n,r) -> let
 134                                 m         = if r < __i0 then n - __i1 else n + __i1
 135                                 half_down = abs r - __rhalf
 136                               in
 137                               case (_tagCmp half_down __i0) of
 138                                 _LT -> n
 139                                 _EQ -> if even n then n else m
 140                                 _GT -> m
 141
 142     ceiling x   = case properFraction x of
 143                     (n,r) -> if r > __i0 then n + __i1 else n
 144
 145     floor x     = case properFraction x of
 146                     (n,r) -> if r < __i0 then n - __i1 else n
 147
 148
 149 -- approxRational, applied to two real fractional numbers x and epsilon,
 150 -- returns the simplest rational number within epsilon of x.  A rational
 151 -- number n%d in reduced form is said to be simpler than another n'%d' if
 152 -- abs n <= abs n' && d <= d'.  Any real interval contains a unique
 153 -- simplest rational; here, for simplicity, we assume a closed rational
 154 -- interval.  If such an interval includes at least one whole number, then
 155 -- the simplest rational is the absolutely least whole number.  Otherwise,
 156 -- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
 157 -- and abs r' < d', and the simplest rational is q%1 + the reciprocal of
 158 -- the simplest rational between d'%r' and d%r.
 159
 160 {-# GENERATE_SPECS approxRational a{Double#,Double} #-}
 161 approxRational  :: (RealFrac a) => a -> a -> Rational
 162
 163 approxRational x eps    =  simplest (x-eps) (x+eps)
 164         where simplest x y | y < x      =  simplest y x
 165                            | x == y     =  xr
 166                            | x > 0      =  simplest' n d n' d'
 167                            | y < 0      =  - simplest' (-n') d' (-n) d
 168                            | otherwise  =  __i0
 169                                         where xr@(n:%d) = toRational x
 170                                               (n':%d')  = toRational y
 171
 172               simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
 173                         | r == __i0  =  q :% __i1
 174                         | q /= q'    =  (q + __i1) :% __i1
 175                         | otherwise  =  (q*n''+d'') :% n''
 176                                      where (q,r)      =  quotRem n d
 177                                            (q',r')    =  quotRem n' d'
 178                                            (n'':%d'') =  simplest' d' r' d r