-- | This module provides the Sifflet Number type and many operations upon it.
-- Most of the operations are provided by making Number an instance
-- of the classes Num, Real, Enum, Integral, Fractional, Floating,
-- and RealFrac.  These are, I think, all of the normal Haskell
-- numeric type classes *except* RealFloat.
-- There are also a few functions defined in addition to the
-- class methods.
--
-- The *primary* purpose of this module is to be the library module
-- used by Sifflet programs exported to Haskell.
-- The *secondary* purpose (maybe no less important, but
-- realized after the first) is to implement the Sifflet
-- number Values (previously done with the VInt and VFloat constructors).

module Data.Number.Sifflet
    (
     Number(..)
    , isExact, toInexact
    , add1, sub1, eqZero, gtZero, ltZero
    )

where

-- | A Number represents a real number, which can be exact (Integer)
-- or inexact (Double).

data Number = Exact Integer | Inexact Double
            deriving (Eq, Read)

-- | Tell whether a Number is exact
isExact :: Number -> Bool
isExact (Exact _) = True
isExact _ = False

-- | Take a number, which may be exact or inexact, and
-- produce the inexact number which equals it.
-- Note that there is no inverse function toExact, 
-- because some inexact numbers like 3.5 are not equal to any exact number.
-- The class RealFrac provides methods round, ceiling, floor, truncate
-- for converting to exact numbers.

toInexact :: Number -> Number
toInexact (Exact x) = Inexact (fromIntegral x)
toInexact xx = xx

toDouble :: Number -> Double
toDouble (Exact ix) = fromIntegral ix
toDouble (Inexact rx) = rx

-- | Unary operations fall into two groups:
-- exactOp1 works only for an exact operand;
--          it is an error if the operand is inexact.
--          The result is always exact.
--          (Unused)
-- inexactOp1 works directly for an inexact operand;
--          otherwise by conversion of its exact operand to inexact;
--          the result is always inexact.
-- eitherOp1 works for either exact or inexact operand,
--          and the result is exact if and only if the operand is exact.

exactOp1 :: String -> (Integer -> Integer) -> (Number -> Number)
exactOp1 name f x =
    case x of
      Exact i -> Exact (f i)
      _ -> error ("Number:" ++ name ++ ": inexact operand: " ++ show x)

inexactOp1 :: (Double -> Double) -> (Number -> Number)
-- inexactOp1 f x = Inexact (f (toDouble x))
inexactOp1 f = Inexact . f . toDouble

eitherOp1 :: (Integer -> Integer) -> (Double -> Double)
       -> (Number -> Number)
eitherOp1 fi fr arg =
    case arg of
      Exact i -> Exact (fi i)
      Inexact r -> Inexact (fr r)

-- | Binary operations fall in 3 groups:
-- exactOp2 is implemented only for exact, exact operands;
--          if there's any inexact operand, it's an error.
--          Integer division operations (quot, rem, div, mod)
--          are like this.  The result is always exact.
-- eitherOp2 is implemented directly for exact, exact operands
--          and inexact, inexact operands; if one operand is
--          exact and the other inexact, the exact operand
--          is converted to inexact.  Most arithmetic operations
--          (+, -, *) are like this.  The result may be exact or inexact.
-- inexactop2 is directly implemented for inexact, inexact operands,
--          but handles exact operands by converting them to inexact
--          (even if both are exact).  Math functions such as
--          exp, log, sqrt, and sin are like this.  The result
--          is always inexact.

exactOp2 :: String -> (Integer -> Integer -> Integer)
         -> (Number -> Number -> Number)

exactOp2 _ f (Exact i) (Exact j) = Exact (f i j)
exactOp2 name _ x y = 
    error ("Number:" ++ name ++ ": inexact operand(s): " ++ 
           show x ++ ", " ++ show y)

inexactOp2 :: (Double -> Double -> Double)
           -> (Number -> Number -> Number)

inexactOp2 f x y = Inexact (f (toDouble x) (toDouble y))


eitherOp2 :: (Integer -> Integer -> Integer)
          -> (Double -> Double -> Double)
          -> (Number -> Number -> Number)

eitherOp2 fi _ (Exact i) (Exact j) = Exact (fi i j)
eitherOp2 _ fx x y = Inexact (fx (toDouble x) (toDouble y))


-- | This Show instance will not be compatible with the
-- derived Read instance above -- so fix it.
-- (And yet, mysteriously, ghci accepts 1 and 1.0 as Number literals.)

instance Show Number where
    show (Exact i) = show i
    show (Inexact x) = show x

-- | Number as an ordered type
instance Ord Number where
    compare (Exact x) (Exact y) = compare x y
    compare (Inexact x) (Inexact y) = compare x y
    compare (Exact x) (Inexact y) = compare (fromIntegral x) y
    compare (Inexact x) (Exact y) = compare x (fromIntegral y)
    -- This could take the place of the previous two:
    -- compare mx my = compare (toInexact mx) (toInexact my)

-- | Number as an instance of Num
instance Num Number where
    (+) = eitherOp2 (+) (+)
    (-) = eitherOp2 (-) (-)
    (*) = eitherOp2 (*) (*)

    negate = eitherOp1 negate negate
    abs = eitherOp1 abs abs
    signum = eitherOp1 signum signum

    fromInteger = Exact

-- | Numbers are Real, i.e., can be converted to Rational
instance Real Number where
    toRational (Exact i) = toRational i
    toRational (Inexact x) = toRational x

-- | In Haskell both Intgeger and Double are instances of Enum,
-- so Number should be an instance too.  Also, this is a prerequisite
-- of being an instance of Integral.

instance Enum Number where

    succ = eitherOp1 succ succ
    pred = eitherOp1 pred pred

    toEnum i = Exact (toEnum i)
    fromEnum x = case x of
                   Exact i -> fromEnum i
                   Inexact r -> fromEnum r

    -- Use default definitions for these methods:
    -- enumFrom       :: a -> [a]            -- [n..]
    -- enumFromThen   :: a -> a -> [a]       -- [n,n'..]
    -- enumFromTo     :: a -> a -> [a]       -- [n..m]
    -- enumFromThenTo :: a -> a -> a -> [a]  -- [n,n'..m]


-- | Numbers are Integral, i.e., can do integer division and convert to
-- Integer.  However, there is a restriction: this only works for Exact
-- numbers; for Inexact, there will be an error.
-- Some may see this as regrettable, but how is it different in principle
-- from division, which doesn't work for zero divisors, and
-- square root, which doesn't work for negative numbers?

instance Integral Number where

    quot = exactOp2 "quot" quot
    rem = exactOp2 "rem" rem
    div = exactOp2 "div" div
    mod = exactOp2 "mod" mod

    Exact i `quotRem` Exact j = 
        let (q, r) = i `quotRem` j in (Exact q, Exact r)
    _ `quotRem` _ = error "Number:quotRem: inexact operand(s)"

    Exact i `divMod` Exact j = 
        let (d, m) = i `divMod` j in (Exact d, Exact m)
    _ `divMod` _ = error "Number:divMod: inexact operand(s)"

    toInteger (Exact i) = i
    toInteger _ = error "Number:toInteger: inexact operand"

    

-- | Numbers are Fractional, i.e., support division and conversion 
-- from Rational.
-- This works directly for inexact Numbers, and otherwise by
-- conversion from Exact to Inexact.
instance Fractional Number where
    
    (/) = inexactOp2 (/)
    recip = inexactOp1 recip
    fromRational r = Inexact (fromRational r)

-- | Numbers are Floating, i.e., support exponential, log, and trig functions.
-- This works directly for inexact Numbers, and otherwise by
-- conversion from Exact to Inexact.
instance Floating Number where

    pi = Inexact pi

    exp = inexactOp1 exp
    log = inexactOp1 log

    sqrt = inexactOp1 sqrt

    sin = inexactOp1 sin
    cos = inexactOp1 cos
    tan = inexactOp1 tan

    asin = inexactOp1 asin
    acos = inexactOp1 acos
    atan = inexactOp1 atan

    sinh = inexactOp1 sinh
    cosh = inexactOp1 cosh
    tanh = inexactOp1 tanh
    asinh = inexactOp1 asinh
    acosh = inexactOp1 acosh
    atanh = inexactOp1 atanh

    -- These methods have defaults:
    -- (**), logBase       :: a -> a -> a

instance RealFrac Number where

    properFraction x =
        case x of 
          Exact i -> (fromIntegral i, Inexact 0.0)
          Inexact r -> let (w, p) = properFraction r
                       in (w, Inexact p)

  -- Default methods:
  -- truncate :: (Integral b) => a -> b
  -- round :: (Integral b) => a -> b
  -- ceiling :: (Integral b) => a -> b
  -- floor :: (Integral b) => a -> b


-- Haskell functions that implement certain Sifflet functions.

add1 :: Number -> Number
add1 = (+ 1)

sub1 :: Number -> Number
sub1 = (+ (-1))

eqZero :: Number -> Bool
eqZero = (== 0)

gtZero :: Number -> Bool
gtZero = (> 0)

ltZero :: Number -> Bool
ltZero = (< 0)

-- Omitting instance RealFloat, this is for data
-- that are *really* floating-point!