module Feldspar.Core.Functions where
import qualified Prelude
import Feldspar.Range
import Feldspar.Core.Types
import Feldspar.Core.Expr
import Feldspar.Core.Reify
import Feldspar.Prelude
import qualified Data.Bits as B
infix 4 ==
infix 4 /=
infix 4 <
infix 4 >
infix 4 <=
infix 4 >=
infixr 3 &&
infixr 3 &&*
infixr 2 ||
infixr 2 ||*
infix 1 ?
noSizeProp :: a -> ()
noSizeProp _ = ()
noSizeProp2 :: a -> b -> ()
noSizeProp2 _ _ = ()
class (Prelude.Eq a, Storable a) => Eq a where
(==) :: Data a -> Data a -> Data Bool
a == b
| a Prelude.== b = true
| otherwise = function2 "(==)" noSizeProp2 (Prelude.==) a b
(/=) :: Data a -> Data a -> Data Bool
a /= b
| a Prelude.== b = false
| otherwise = function2 "(/=)" noSizeProp2 (Prelude./=) a b
optEq :: (Storable a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optEq a b
| a Prelude.== b = true
| sa `disjoint` sb = false
| otherwise = function2 "(==)" noSizeProp2 (Prelude.==) a b
where
sa = dataSize a
sb = dataSize b
optNeq :: (Storable a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optNeq a b
| a Prelude.== b = false
| sa `disjoint` sb = true
| otherwise = function2 "(/=)" noSizeProp2 (Prelude./=) a b
where
sa = dataSize a
sb = dataSize b
instance Eq Int where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Signed32 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Unsigned32 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Signed16 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Unsigned16 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Signed8 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Unsigned8 where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Float where
a == b = optEq a b
a /= b = optNeq a b
instance Eq Bool
instance Eq ()
class (Prelude.Ord a, Eq a, Storable a) => Ord a where
(<) :: Data a -> Data a -> Data Bool
a < b
| a Prelude.== b = false
| otherwise = function2 "(<)" noSizeProp2 (Prelude.<) a b
(>) :: Data a -> Data a -> Data Bool
a > b
| a Prelude.== b = false
| otherwise = function2 "(>)" noSizeProp2 (Prelude.>) a b
(<=) :: Data a -> Data a -> Data Bool
a <= b
| a Prelude.== b = true
| otherwise = function2 "(<=)" noSizeProp2 (Prelude.<=) a b
(>=) :: Data a -> Data a -> Data Bool
a >= b
| a Prelude.== b = true
| otherwise = function2 "(>=)" noSizeProp2 (Prelude.>=) a b
min :: Data a -> Data a -> Data a
min a b = a<b ? (a,b)
max :: Data a -> Data a -> Data a
max a b = a>b ? (a,b)
optLT :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optLT a b
| a Prelude.== b = false
| sa `rangeLess` sb = true
| sb `rangeLessEq` sa = false
| otherwise = function2 "(<)" noSizeProp2 (Prelude.<) a b
where
sa = dataSize a
sb = dataSize b
optGT :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optGT a b
| a Prelude.== b = false
| sb `rangeLess` sa = true
| sa `rangeLessEq` sb = false
| otherwise = function2 "(>)" noSizeProp2 (Prelude.>) a b
where
sa = dataSize a
sb = dataSize b
optLTE :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optLTE a b
| a Prelude.== b = true
| sa `rangeLessEq` sb = true
| sb `rangeLess` sa = false
| otherwise = function2 "(<=)" noSizeProp2 (Prelude.<=) a b
where
sa = dataSize a
sb = dataSize b
optGTE :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data Bool
optGTE a b
| a Prelude.== b = true
| sb `rangeLessEq` sa = true
| sa `rangeLess` sb = false
| otherwise = function2 "(>=)" noSizeProp2 (Prelude.>=) a b
where
sa = dataSize a
sb = dataSize b
optMin :: (Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data a
optMin a b = cap (rangeMin ra rb) $
case dataToExpr cond1 of
Value _ -> cond1 ? (a,b)
_ -> cond2 ? (b,a)
where
cond1 = a<b
cond2 = b<a
ra = dataSize a
rb = dataSize b
optMax :: (Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data a
optMax a b = cap (rangeMax ra rb) $
case dataToExpr cond1 of
Value _ -> cond1 ? (a,b)
_ -> cond2 ? (b,a)
where
cond1 = a>b
cond2 = b>a
ra = dataSize a
rb = dataSize b
instance Ord Int where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Unsigned32 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Signed32 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Unsigned16 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Signed16 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Unsigned8 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Signed8 where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
instance Ord Float where
a < b = optLT a b
a > b = optGT a b
a <= b = optLTE a b
a >= b = optGTE a b
min a b = optMin a b
max a b = optMax a b
not :: Data Bool -> Data Bool
not = function "not" noSizeProp Prelude.not
(?) :: Computable a => Data Bool -> (a,a) -> a
cond ? (a,b) = ifThenElse cond (const a) (const b) unit
(&&) :: Data Bool -> Data Bool -> Data Bool
x && y = case (dataToExpr x, dataToExpr y) of
(Value True, _) -> y
(Value False,_) -> false
(_, Value True) -> x
(_,Value False) -> false
_ -> function2 "(&&)" noSizeProp2 (Prelude.&&) x y
(||) :: Data Bool -> Data Bool -> Data Bool
x || y = case (dataToExpr x, dataToExpr y) of
(Value True, _) -> true
(Value False,_) -> y
(_, Value True) -> true
(_,Value False) -> y
_ -> function2 "(||)" noSizeProp2 (Prelude.||) x y
(&&*) :: Computable a =>
(a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f &&* g) a = ifThenElse (f a) g (const false) a
(||*) :: Computable a =>
(a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f ||* g) a = ifThenElse (f a) (const true) g a
class (Numeric a, Prelude.Integral a, Ord a, Storable a) =>
Integral a where
quot :: Data a -> Data a -> Data a
quot = function2 "quot" (\_ _ -> universal) Prelude.quot
rem :: Data a -> Data a -> Data a
rem = function2 "rem" (\_ _ -> universal) Prelude.rem
div :: Data a -> Data a -> Data a
div x y = rem x y /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
(quotxy 1, quotxy)
where quotxy = quot x y
mod :: Data a -> Data a -> Data a
mod x y = remxy /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
(remxy + y, remxy)
where remxy = rem x y
(^) :: Data a -> Data a -> Data a
(^) = function2 "(^)" (\_ _ -> universal) (Prelude.^)
optRem :: (Integral a, Size a ~ Range b, Prelude.Ord b, Num b, Enum b) =>
Data a -> Data a -> Data a
optRem x y
| abs rx `rangeLess` abs ry = x
| otherwise = function2 "rem" rangeRem Prelude.rem x y
where rx = dataSize x
ry = dataSize y
optMod :: (Integral a, Size a ~ Range b, Prelude.Ord b, Num b, Enum b) =>
Data a -> Data a -> Data a
optMod x y = cap (rangeMod rx ry) $
remxy /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
(remxy + y, remxy)
where remxy = rem x y
rx = dataSize x
ry = dataSize y
optSignedExp :: (Integral a, Bits a, Storable a,
Size a ~ Range b, Prelude.Ord b, Num b) =>
Data a -> Data a -> Data a
optSignedExp m e = case dataToExpr m of
Value (1) -> cap (range (1) 1) $
let isOdd = e .&. 1
in (1 `xor` (negate isOdd)) + isOdd
_ -> optExp m e
optExp :: (Integral a, Storable a) => Data a -> Data a -> Data a
optExp m e = case (dataToExpr m,dataToExpr e) of
(Value 1,_) -> value 1
(_,Value 1) -> m
(_,Value 0) -> value 1
_ -> function2 "(^)" (\_ _ -> universal) (Prelude.^) m e
instance Integral Int where
rem = optRem
mod = optMod
(^) = optSignedExp
instance Integral Signed32 where
rem = optRem
mod = optMod
(^) = optSignedExp
instance Integral Unsigned32 where
div = quot
rem = optRem
mod = rem
(^) = optExp
instance Integral Signed16 where
rem = optRem
mod = optMod
(^) = optSignedExp
instance Integral Unsigned16 where
div = quot
rem = optRem
mod = rem
(^) = optExp
instance Integral Signed8 where
rem = optRem
mod = optMod
(^) = optSignedExp
instance Integral Unsigned8 where
div = quot
rem = optRem
mod = rem
(^) = optExp
for :: Computable a => Data Int -> Data Int -> a -> (Data Int -> a -> a) -> a
for start end init body = snd $ whileSized szCont szBody cont body' (start,init)
where
sziCont = rangeByRange (dataSize start) (dataSize end + 1)
szCont = (sziCont,universal)
sziBody = rangeByRange (dataSize start) (dataSize end)
szBody = (sziBody,universal)
cont (i,s) = i <= end
body' (i,s) = (i+1, body i s)
unfoldCore
:: (Computable state, Storable a)
=> Data Length
-> state
-> (Data Int -> state -> (Data a, state))
-> (Data [a], state)
unfoldCore l init step = for 0 (l1) (outp,init) $ \i (o,state) ->
let (a,state') = step i state
in (setIx o i a, state')
where
outp = array (mapMonotonic fromIntegral (dataSize l) :> universal) []
class (Num a, Storable a) => Numeric a
where
fromIntegerNum :: Integer -> Data a
fromIntegerNum = value . fromInteger
absNum :: Data a -> Data a
signumNum :: Data a -> Data a
addNum :: Data a -> Data a -> Data a
subNum :: Data a -> Data a -> Data a
mulNum :: Data a -> Data a -> Data a
absNum' :: (Numeric a, Num (Size a)) => Data a -> Data a
absNum' = function "abs" abs abs
optAbs :: (Numeric a, Size a ~ Range b, Num b, Prelude.Ord b) =>
Data a -> Data a
optAbs x | isNatural rx = x
| otherwise = absNum' x
where rx = dataSize x
signumNum' :: (Numeric a, Num (Size a)) => Data a -> Data a
signumNum' = function "signum" signum signum
optSignum :: (Numeric a, Size a ~ Range b, Num b, Prelude.Ord b) => Data a -> Data a
optSignum x | 0 `rangeLess` rx = 1
| rx `rangeLess` 0 = 1
| rx Prelude.== 0 = 0
| otherwise = signumNum' x
where rx = dataSize x
optAdd :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optAdd x y = case (dataToExpr x, dataToExpr y) of
(Value 0, _) -> y
(_, Value 0) -> x
_ -> function2 "(+)" (+) (+) x y
optSub :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optSub x y = case dataToExpr y of
Value 0 -> x
_ -> function2 "(-)" () () x y
optMul :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optMul x y = case (dataToExpr x, dataToExpr y) of
(Value 0,_) -> value 0
(_,Value 0) -> value 0
(Value 1,_) -> y
(_,Value 1) -> x
_ -> function2 "(*)" (*) (*) x y
instance Numeric Int
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Unsigned32
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Signed32
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Unsigned16
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Signed16
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Unsigned8
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Signed8
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric Float
where
absNum = optAbs
signumNum = optSignum
addNum = optAdd
subNum = optSub
mulNum = optMul
instance Numeric a => Num (Data a)
where
fromInteger = fromIntegerNum
abs = absNum
signum = signumNum
(+) = addNum
() = subNum
(*) = mulNum
class (Fractional a, Storable a) => Fractional' a
where
fromRationalFrac :: Rational -> Data a
fromRationalFrac = value . fromRational
divFrac :: Data a -> Data a -> Data a
instance Fractional' Float
where
divFrac = function2 "(/)" (\_ _ -> fullRange) (/)
instance (Fractional' a, Numeric a) => Fractional (Data a)
where
fromRational = fromRationalFrac
(/) = divFrac
infixl 5 <<,>>
infixl 4 ⊕
class (B.Bits a, Storable a) => Bits a
where
(.&.) :: Data a -> Data a -> Data a
(.&.) = optAnd
(.|.) :: Data a -> Data a -> Data a
(.|.) = optOr
xor :: Data a -> Data a -> Data a
xor = optXor
(⊕) :: Data a -> Data a -> Data a
(⊕) = xor
complement :: Data a -> Data a
complement = function "complement" (const universal) B.complement
bit :: Data Int -> Data a
bit = function "bit" (const universal) B.bit
setBit :: Data a -> Data Int -> Data a
setBit = function2 "setBit" (\_ _ -> universal) B.setBit
clearBit :: Data a -> Data Int -> Data a
clearBit = function2 "clearBit" (\_ _ -> universal) B.clearBit
complementBit :: Data a -> Data Int -> Data a
complementBit = function2 "complementBit" (\_ _ -> universal) B.complementBit
testBit :: Data a -> Data Int -> Data Bool
testBit = function2 "testBit" noSizeProp2 B.testBit
shiftL :: Data a -> Data Int -> Data a
shiftL = optZero (function2 "shiftL" (\_ _ -> universal) B.shiftL)
(<<) :: Data a -> Data Int -> Data a
(<<) = shiftL
shiftR :: Data a -> Data Int -> Data a
shiftR = optZero (function2 "shiftR" (\_ _ -> universal) B.shiftR)
(>>) :: Data a -> Data Int -> Data a
(>>) = shiftR
rotateL :: Data a -> Data Int -> Data a
rotateL = optZero (function2 "rotateL" (\_ _ -> universal) B.rotateL)
rotateR :: Data a -> Data Int -> Data a
rotateR = optZero (function2 "rotateR" (\_ _ -> universal) B.rotateR)
reverseBits :: Data a -> Data a
reverseBits = function "reverseBits" (\_ -> universal) revBits
bitScan :: Data a -> Data Int
bitScan = function "bitScan" (\_ -> universal) scanLeft
bitCount :: Data a -> Data Int
bitCount = function "bitCount" (\_ -> universal) countBits
bitSize :: Data a -> Data Int
bitSize = function "bitSize" (const naturalRange) B.bitSize
isSigned :: Data a -> Data Bool
isSigned = function "isSigned" noSizeProp B.isSigned
optAnd :: (B.Bits a, Storable a) => Data a -> Data a -> Data a
optAnd x y = case (dataToExpr x, dataToExpr y) of
(Value 0, _) -> value 0
(_, Value 0) -> value 0
(Value x, _) | allOnes x -> y
(_, Value y) | allOnes y -> x
_ -> function2 "(.&.)" (\_ _ -> universal) (B..&.) x y
optOr :: (B.Bits a, Storable a) => Data a -> Data a -> Data a
optOr x y = case (dataToExpr x, dataToExpr y) of
(Value 0, _) -> y
(_, Value 0) -> x
(Value x, _) | allOnes x -> value (B.complement 0)
(_, Value y) | allOnes y -> value (B.complement 0)
_ -> function2 "(.|.)" (\_ _ -> universal) (B..|.) x y
optXor :: (Bits a, B.Bits a, Storable a) => Data a -> Data a -> Data a
optXor x y = case (dataToExpr x, dataToExpr y) of
(Value 0, _) -> y
(_, Value 0) -> x
(Value x, _) | allOnes x -> complement y
(_, Value y) | allOnes y -> complement x
_ -> function2 "xor" (\_ _ -> universal) B.xor x y
allOnes :: (Prelude.Eq a, B.Bits a) => a -> Bool
allOnes x = x Prelude.== B.complement 0
optZero :: (a -> Data Int -> a) -> a -> Data Int -> a
optZero f x y = case dataToExpr y of
Value 0 -> x
_ -> f x y
scanLeft :: B.Bits b => b -> Int
scanLeft b =
if B.isSigned b
then scanLoop b (B.testBit b (B.bitSize b 1)) (B.bitSize b 2) 0
else scanLoop b False (B.bitSize b 1) 0
where
scanLoop b bit i n | i Prelude.< 0 = n
scanLoop b bit i n | B.testBit b i Prelude./= bit = n
scanLoop b bit i n | otherwise = scanLoop b bit (i1) (n+1)
countBits :: B.Bits b => b -> Int
countBits b = loop b (B.bitSize b 1) 0
where
loop b i n | i Prelude.< 0 = n
loop b i n | B.testBit b i = loop b (i1) (n+1)
loop b i n | otherwise = loop b (i1) n
revBits :: B.Bits b => b -> b
revBits b = revLoop b 0 (0 `asTypeOf` b)
where
bitSize = B.bitSize b
revLoop b i n | i Prelude.>= bitSize = n
revLoop b i n | B.testBit b i = revLoop b (i+1) (B.setBit n (bitSize i 1))
revLoop b i n | otherwise = revLoop b (i+1) n
instance Bits Int
instance Bits Unsigned32
instance Bits Signed32
instance Bits Unsigned16
instance Bits Signed16
instance Bits Unsigned8
instance Bits Signed8