[project @ 1998-12-02 13:17:09 by simonm]

[ghc-hetmet.git] / ghc / interpreter / library / Ratio.hs

diff --git a/ghc/interpreter/library/Ratio.hs b/ghc/interpreter/library/Ratio.hs
new file mode 100644 (file)
index 0000000..e301438
--- /dev/null
+++ b/ghc/interpreter/library/Ratio.hs
@@ -0,0 +1,103 @@
+-- Standard functions on rational numbers
+
+#ifdef HEAD
+module  Ratio (
+    Ratio, Rational, (%), numerator, denominator, approxRational ) where
+
+#if STD_PRELUDE
+infixl 7  %
+#endif
+
+import PreludeBuiltin
+#endif /* HEAD */
+#ifdef BODY
+
+data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
+type  Rational          =  Ratio BIGNUMTYPE
+
+(%)                     :: (Integral a) => a -> a -> Ratio a
+numerator, denominator  :: (Integral a) => Ratio a -> a
+approxRational          :: (RealFrac a) => a -> a -> Rational
+
+
+-- "reduce" is a subsidiary function used only in this module.
+-- It normalises a ratio by dividing both numerator
+-- and denominator by their greatest common divisor.
+--
+-- E.g., 12 `reduce` 8    ==  3 :%   2
+--       12 `reduce` (-8) ==  3 :% (-2)
+
+reduce _ 0              =  error "Ratio.% : zero denominator"
+reduce x y              =  (x `quot` d) :% (y `quot` d)
+                           where d = gcd x y
+
+x % y                   =  reduce (x * signum y) (abs y)
+
+numerator   (x :% _)   =  x
+
+denominator (_ :% y)   =  y
+
+
+instance  (Integral a)  => Ord (Ratio a)  where
+    (x:%y) <= (x':%y')  =  x * y' <= x' * y
+    (x:%y) <  (x':%y')  =  x * y' <  x' * y
+
+instance  (Integral a)  => Num (Ratio a)  where
+    (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')
+    (x:%y) * (x':%y')   =  reduce (x * x') (y * y')
+    negate (x:%y)       =  (-x) :% y
+    abs (x:%y)          =  abs x :% y
+    signum (x:%y)       =  signum x :% 1
+    fromInteger x       =  fromInteger x :% 1
+
+instance  (Integral a)  => Real (Ratio a)  where
+    toRational (x:%y)   =  toInteger x :% toInteger y
+
+instance  (Integral a)  => Fractional (Ratio a)  where
+    (x:%y) / (x':%y')   =  (x*y') % (y*x')
+    recip (x:%y)        =  if x < 0 then (-y) :% (-x) else y :% x
+    fromRational (x:%y) =  fromInteger x :% fromInteger y
+
+instance  (Integral a)  => RealFrac (Ratio a)  where
+    properFraction (x:%y) = (fromIntegral q, r:%y)
+                            where (q,r) = quotRem x y
+
+instance  (Integral a)  => Enum (Ratio a)  where
+    enumFrom           =  numericEnumFrom
+    enumFromThen       =  numericEnumFromThen
+    enumFromTo         =  numericEnumFromTo
+    enumFromThenTo     =  numericEnumFromThenTo
+    toEnum              =  fromInteger . toInteger
+    fromEnum n          =  error "Ratio.fromEnum: can't use\ 
+                                  \ fromEnum with Ratio"
+
+instance  (Read a, Integral a)  => Read (Ratio a)  where
+    readsPrec p  =  readParen (p > 7)
+                              (\r -> [(x%y,u) | (x,s)   <- reads r,
+                                                ("%",t) <- lex s,
+                                                (y,u)   <- reads t ])
+
+instance  (Integral a)  => Show (Ratio a)  where
+    showsPrec p (x:%y)  =  showParen (p > 7)
+                               (shows x . showString " % " . shows y)
+
+
+
+approxRational x eps    =  simplest (x-eps) (x+eps)
+        where simplest x y | y < x      =  simplest y x
+                           | x == y     =  xr
+                           | x > 0      =  simplest' n d n' d'
+                           | y < 0      =  - simplest' (-n') d' (-n) d
+                           | otherwise  =  0 :% 1
+                                        where xr@(n:%d) = toRational x
+                                              (n':%d')  = toRational y
+
+              simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
+                        | r == 0     =  q :% 1
+                        | q /= q'    =  (q+1) :% 1
+                        | otherwise  =  (q*n''+d'') :% n''
+                                     where (q,r)      =  quotRem n d
+                                           (q',r')    =  quotRem n' d'
+                                           (n'':%d'') =  simplest' d' r' d r
+
+#endif /* BODY */