{-# OPTIONS_GHC -fno-warn-orphans #-}

module Language.Futhark.PrimitiveTests
  ( tests,
    arbitraryPrimValOfType,
  )
where

import Control.Applicative
import Futhark.Util (convFloat)
import Language.Futhark.Primitive
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit
import Prelude

tests :: TestTree
tests :: TestTree
tests = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"PrimitiveTests" [TestTree
propPrimValuesHaveRightType]

propPrimValuesHaveRightType :: TestTree
propPrimValuesHaveRightType :: TestTree
propPrimValuesHaveRightType =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"propPrimValuesHaveRightTypes"
    [ [Char] -> Assertion -> TestTree
testCase (PrimType -> [Char]
forall a. Show a => a -> [Char]
show PrimType
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" has blank of right type") (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        PrimValue -> PrimType
primValueType (PrimType -> PrimValue
blankPrimValue PrimType
t) PrimType -> PrimType -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= PrimType
t
      | PrimType
t <- [PrimType
forall a. Bounded a => a
minBound .. PrimType
forall a. Bounded a => a
maxBound]
    ]

instance Arbitrary IntType where
  arbitrary :: Gen IntType
arbitrary = [IntType] -> Gen IntType
forall a. HasCallStack => [a] -> Gen a
elements [IntType
forall a. Bounded a => a
minBound .. IntType
forall a. Bounded a => a
maxBound]

instance Arbitrary FloatType where
  arbitrary :: Gen FloatType
arbitrary = [FloatType] -> Gen FloatType
forall a. HasCallStack => [a] -> Gen a
elements [FloatType
forall a. Bounded a => a
minBound .. FloatType
forall a. Bounded a => a
maxBound]

instance Arbitrary PrimType where
  arbitrary :: Gen PrimType
arbitrary = [PrimType] -> Gen PrimType
forall a. HasCallStack => [a] -> Gen a
elements [PrimType
forall a. Bounded a => a
minBound .. PrimType
forall a. Bounded a => a
maxBound]

instance Arbitrary IntValue where
  arbitrary :: Gen IntValue
arbitrary =
    [Gen IntValue] -> Gen IntValue
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Int8 -> IntValue
Int8Value (Int8 -> IntValue) -> Gen Int8 -> Gen IntValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int8
forall a. Arbitrary a => Gen a
arbitrary,
        Int16 -> IntValue
Int16Value (Int16 -> IntValue) -> Gen Int16 -> Gen IntValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int16
forall a. Arbitrary a => Gen a
arbitrary,
        Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> Gen Int32 -> Gen IntValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int32
forall a. Arbitrary a => Gen a
arbitrary,
        Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> Gen Int64 -> Gen IntValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int64
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary Half where
  arbitrary :: Gen Half
arbitrary = (Float -> Half
forall from to. (RealFloat from, RealFloat to) => from -> to
convFloat :: Float -> Half) (Float -> Half) -> Gen Float -> Gen Half
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary FloatValue where
  arbitrary :: Gen FloatValue
arbitrary =
    [Gen FloatValue] -> Gen FloatValue
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Half -> FloatValue
Float16Value (Half -> FloatValue) -> Gen Half -> Gen FloatValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Half
forall a. Arbitrary a => Gen a
arbitrary,
        Float -> FloatValue
Float32Value (Float -> FloatValue) -> Gen Float -> Gen FloatValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary,
        Double -> FloatValue
Float64Value (Double -> FloatValue) -> Gen Double -> Gen FloatValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary PrimValue where
  arbitrary :: Gen PrimValue
arbitrary =
    [Gen PrimValue] -> Gen PrimValue
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> Gen IntValue -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IntValue
forall a. Arbitrary a => Gen a
arbitrary,
        FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> Gen FloatValue -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FloatValue
forall a. Arbitrary a => Gen a
arbitrary,
        Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Gen Bool -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary,
        PrimValue -> Gen PrimValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimValue
UnitValue
      ]

arbitraryPrimValOfType :: PrimType -> Gen PrimValue
arbitraryPrimValOfType :: PrimType -> Gen PrimValue
arbitraryPrimValOfType (IntType IntType
Int8) = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value (Int8 -> PrimValue) -> Gen Int8 -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int8
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (IntType IntType
Int16) = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value (Int16 -> PrimValue) -> Gen Int16 -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int16
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (IntType IntType
Int32) = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> PrimValue) -> Gen Int32 -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int32
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (IntType IntType
Int64) = IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value (Int64 -> PrimValue) -> Gen Int64 -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int64
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (FloatType FloatType
Float16) = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Half -> FloatValue) -> Half -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> FloatValue
Float16Value (Half -> PrimValue) -> Gen Half -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Half
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (FloatType FloatType
Float32) = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Float -> FloatValue) -> Float -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
Float32Value (Float -> PrimValue) -> Gen Float -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType (FloatType FloatType
Float64) = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Float -> FloatValue) -> Float -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
Float32Value (Float -> PrimValue) -> Gen Float -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType PrimType
Bool = Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Gen Bool -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
arbitraryPrimValOfType PrimType
Unit = PrimValue -> Gen PrimValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimValue
UnitValue