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