-- | Numeric operations

module Feldspar.Core.Functions.Num where

import Data.Complex
import Data.Int
import Data.Word

import Data.Tagged

import Feldspar.Range
import Feldspar.Core.Types
import Feldspar.Core.Representation
import Feldspar.Core.Constructs

-- | Numeric types. The relation to the standard 'Num' class is
--
-- @instance `Numeric` a => `Num` (`Data` a)@
class (Type a, Num a, FullProp (Size a)) => Numeric a
  where
    fromIntegerNum :: Integer -> Data a
    fromIntegerNum = value . fromInteger

    absNum    :: Data a -> Data a
    absNum    =  defaultAbs fullProp
    signumNum :: Data a -> Data a
    signumNum =  defaultSignum fullProp
    addNum    :: Data a -> Data a -> Data a
    addNum    =  defaultAdd fullProp
    subNum    :: Data a -> Data a -> Data a
    subNum    =  defaultSub fullProp
    mulNum    :: Data a -> Data a -> Data a
    mulNum    =  defaultMul fullProp

    rangeToSize :: Range Integer -> Tagged a (Size a)
    rangeToSize _ = Tagged fullProp

defaultAbs :: Numeric a => (Size a -> Size a) -> Data a -> Data a
defaultAbs szProp = function1 "abs" szProp abs

defaultSignum :: Numeric a => (Size a -> Size a) -> Data a -> Data a
defaultSignum szProp = function1 "signum" szProp signum

defaultAdd :: Numeric a =>
    (Size a -> Size a -> Size a) -> Data a -> Data a -> Data a
defaultAdd szProp = function2 "(+)" szProp (+)

defaultSub :: Numeric a =>
    (Size a -> Size a -> Size a) -> Data a -> Data a -> Data a
defaultSub szProp = function2 "(-)" szProp (-)

defaultMul :: Numeric a =>
    (Size a -> Size a -> Size a) -> Data a -> Data a -> Data a
defaultMul szProp = function2 "(*)" szProp (*)

optAbs :: (Numeric a, BoundedInt b, Size a ~ Range b) => Data a -> Data a
optAbs x | isNatural rx = x
         | otherwise    = defaultAbs abs x
  where rx = dataSize x

optSignum :: (Numeric a, BoundedInt b, Size a ~ Range b) => Data a -> Data a
optSignum x | 0  `rangeLess` rx =  1
            | rx `rangeLess` 0  = -1
            | rx Prelude.==  0  =  0
            | otherwise         = defaultSignum signum x
  where rx = dataSize x

optAdd :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optAdd x y = case (viewLiteral x, viewLiteral y) of
               (Just 0, _) -> y
               (_, Just 0) -> x
               _           -> defaultAdd (+) x y

optSub  :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optSub x y = case viewLiteral y of
               Just 0 -> x
               _      -> defaultSub (-) x y

optMul :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optMul x y = case (viewLiteral x, viewLiteral y) of
               (Just 0,_) -> value 0
               (_,Just 0) -> value 0
               (Just 1,_) -> y
               (_,Just 1) -> x
               _          -> defaultMul (*) x y

rangeProp :: forall a . (Bounded a, Integral a, Size a ~ Range a) =>
             Range Integer -> Tagged a (Size a)
rangeProp (Range l u)
    | withinBounds l && withinBounds u
        = Tagged $ range (fromIntegral l) (fromIntegral u)
    | otherwise = Tagged (range minBound maxBound)
  where withinBounds i = toInteger (minBound :: a) <= i &&
                         i <= toInteger (maxBound :: a)

instance Numeric Word8
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Int8
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Word16
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Int16
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Word32
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Int32
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric DefaultWord
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric DefaultInt
  where
    absNum      = optAbs
    signumNum   = optSignum
    addNum      = optAdd
    subNum      = optSub
    mulNum      = optMul
    rangeToSize = rangeProp

instance Numeric Float
instance (Type a, RealFloat a) => Numeric (Complex a)

instance Numeric a => Num (Data a)
  where
    fromInteger = fromIntegerNum
    abs         = absNum
    signum      = signumNum
    (+)         = addNum
    (-)         = subNum
    (*)         = mulNum