-- | 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!