1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16   module QRationals
   17    (QRational, (%%), qNumerator, qDenominator,
   18     qInfinite, qUndefined, qRound, qFinite) where
   19   import Ratio
   20   infixl 7  %% , :%%
   21   prec = 7::Int
   22 
   23   data  QRational               =  Integer :%% Integer deriving (Eq)
   24 
   25   qReduce, (%%)                 :: Integer -> Integer -> QRational
   26   qNumerator, qDenominator      :: QRational -> Integer
   27 
   28 
   29 
   30 
   31   qReduce x 0                   =  signum x :%% 0
   32   qReduce x y                   =  (signum x * (abs x `div` d)) :%% (y `div` d)
   33                                    where d = gcd x y
   34 
   35   x %% 0                        =  signum x :%% 0
   36   x %% y                        =  qReduce (x * signum y) (abs y)
   37 
   38   qNumerator (x:%%y)            =  x
   39 
   40   qDenominator (x:%%y)          =  y
   41 
   42   instance Ord QRational where
   43       (x:%%y) <= (x':%%y')      =  x * y' <= x' * y
   44       (x:%%y) <  (x':%%y')      =  x * y' <  x' * y
   45 
   46   instance Num QRational where
   47       (x:%%y) + (x':%%y')       =  qReduce (x*y' + x'*y) (y*y')
   48       (x:%%y) - (x':%%y')       =  qReduce (x*y' - x'*y) (y*y')
   49       (x:%%y) * (x':%%y')       =  qReduce (x * x') (y * y')
   50       negate (x:%% y)           =  (-x) :%% y
   51       abs (x:%% y)              =  abs x :%% y
   52       signum (x:%% y)           =  signum x :%% 1
   53       fromInteger x             =  fromInteger x :%% 1
   54 
   55   instance Real QRational where
   56       toRational (x:%%y)        =  x%y
   57 
   58   instance Fractional QRational  where
   59       (x:%%y) / (x':%%y')       =  (x*y') %% (y*x')
   60       recip (x:%%y)             =  if x < 0 then (-y):%% (-x) else y:%%x
   61       fromRational x            =  numerator x :%% denominator x
   62 
   63   instance  Enum QRational where
   64         enumFrom x              = enumFromBy x 1
   65         enumFromThen x y        = enumFromBy x (y - x)
   66 
   67   enumFromBy n k                =  n : enumFromBy (n+k) k
   68 
   69   instance  Read QRational  where
   70         readsPrec p             =  readParen (p > prec)
   71                                     (\r -> [(x%%y,u) | (x,s)    <- reads r,
   72                                                        ("%%",t) <- lex s,
   73                                                        (y,u)    <- reads t ])
   74   instance  Show QRational  where
   75         showsPrec p (x:%%y)     = showParen (p > prec) (shows x .
   76                                                         showString " %% " .
   77                                                         shows y)
   78 
   79 
   80 
   81   qInfinite   :: QRational -> Bool
   82   qInfinite x  = qDenominator x == 0 && qNumerator x /= 0
   83 
   84   qUndefined  :: QRational -> Bool
   85   qUndefined x = qDenominator x == 0 && qNumerator x == 0
   86 
   87   qRound      :: QRational -> Integer
   88   qRound x     = if qUndefined x || qInfinite x
   89                  then error "qRound: undefined or infinite"
   90                  else (2*qNumerator x + d) `div` (2*d) where d = qDenominator x
   91 
   92   qFinite     :: QRational -> Bool
   93   qFinite x    = qDenominator x /= 0
   94 
   95