module Feldspar.Core.Functions where
import qualified Prelude
import Feldspar.Range
import Feldspar.Core.Types
import Feldspar.Core.Expr
import Feldspar.Prelude
import qualified Data.Bits as B
infix 4 ==
infix 4 /=
infix 4 <
infix 4 >
infix 4 <=
infix 4 >=
infix 1 ?
noSizeProp :: a -> ()
noSizeProp _ = ()
noSizeProp2 :: a -> b -> ()
noSizeProp2 _ _ = ()
(==) :: Storable a => Data a -> Data a -> Data Bool
a == b
| a Prelude.== b = true
| otherwise = function2 "(==)" noSizeProp2 (Prelude.==) a b
(/=) :: Storable a => Data a -> Data a -> Data Bool
a /= b
| a Prelude.== b = false
| otherwise = function2 "(/=)" noSizeProp2 (Prelude./=) a b
(<) :: Storable a => Data a -> Data a -> Data Bool
a < b
| a Prelude.== b = false
| otherwise = function2 "(<)" noSizeProp2 (Prelude.<) a b
(>) :: Storable a => Data a -> Data a -> Data Bool
a > b
| a Prelude.== b = false
| otherwise = function2 "(>)" noSizeProp2 (Prelude.>) a b
(<<<) :: Data Int -> Data Int -> Data Bool
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
(>>>) :: Data Int -> Data Int -> Data Bool
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
(<=) :: Storable a => Data a -> Data a -> Data Bool
a <= b
| a Prelude.== b = true
| otherwise = function2 "(<=)" noSizeProp2 (Prelude.<=) a b
(>=) :: Storable a => Data a -> Data a -> Data Bool
a >= b
| a Prelude.== b = true
| otherwise = function2 "(>=)" noSizeProp2 (Prelude.>=) 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
(&&) = function2 "(&&)" noSizeProp2 (Prelude.&&)
(||) :: Data Bool -> Data Bool -> Data Bool
(||) = function2 "(||)" noSizeProp2 (Prelude.||)
(&&*) :: 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
min :: Storable a => Data a -> Data a -> Data a
min a b = a<b ? (a,b)
max :: Storable a => Data a -> Data a -> Data a
max a b = a>b ? (a,b)
minX :: Data Int -> Data Int -> Data Int
minX a b = case dataToExpr cond1 of
Value _ _ -> cond1 ? (a,b)
_ -> cond2 ? (b,a)
where
cond1 = a<<<b
cond2 = b<<<a
maxX :: Data Int -> Data Int -> Data Int
maxX a b = case dataToExpr cond1 of
Value _ _ -> cond1 ? (a,b)
_ -> cond2 ? (b,a)
where
cond1 = a>>>b
cond2 = b>>>a
div :: Data Int -> Data Int -> Data Int
div = function2 "div" (\_ _ -> fullRange) Prelude.div
mod :: Data Int -> Data Int -> Data Int
mod = function2 "mod" (\_ _ -> fullRange) Prelude.mod
(^) :: Data Int -> Data Int -> Data Int
(^) = function2 "(^)" (\_ _ -> fullRange) (Prelude.^)
for :: Computable a => Data Int -> Data Int -> a -> (Data Int -> a -> a) -> a
for start end init body = snd $ whileSized sz cont body' (start,init)
where
szi = rangeByRange (dataSize start) (dataSize end)
sz = (szi,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) []
infixl 5 <<,>>
infixl 4 ⊕
class (B.Bits a, Storable a) => Bits a
where
(.&.) :: Data a -> Data a -> Data a
(.&.) = function2 "(.&.)" (\_ _ -> universal) (B..&.)
(.|.) :: Data a -> Data a -> Data a
(.|.) = function2 "(.|.)" (\_ _ -> universal) (B..|.)
xor :: Data a -> Data a -> Data a
xor = function2 "xor" (\_ _ -> universal) B.xor
(⊕) :: 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 = function2 "shiftL" (\_ _ -> universal) B.shiftL
(<<) :: Data a -> Data Int -> Data a
(<<) = shiftL
shiftR :: Data a -> Data Int -> Data a
shiftR = function2 "shiftR" (\_ _ -> universal) B.shiftR
(>>) :: Data a -> Data Int -> Data a
(>>) = shiftR
rotateL :: Data a -> Data Int -> Data a
rotateL = function2 "rotateL" (\_ _ -> universal) B.rotateL
rotateR :: Data a -> Data Int -> Data a
rotateR = function2 "rotateR" (\_ _ -> universal) B.rotateR
bitSize :: Data a -> Data Int
bitSize = function "bitSize" (const naturalRange) B.bitSize
isSigned :: Data a -> Data Bool
isSigned = function "isSigned" noSizeProp B.isSigned
instance Bits Int