1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module Futhark.Analysis.AlgSimplifyTests
( tests,
)
where
import Control.Monad
import Data.Function ((&))
import Data.List (subsequences)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, mapMaybe)
import Futhark.Analysis.AlgSimplify hiding (add, sub)
import Futhark.Analysis.PrimExp
import Futhark.IR.Syntax.Core
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
tests :: TestTree
tests =
testGroup
"AlgSimplifyTests"
[ testProperty "simplify is idempotent" $ \(TestableExp e) -> simplify e == simplify (simplify e),
testProperty "simplify doesn't change exp evalutation result" $
\(TestableExp e) ->
evalPrimExp (\_ -> Nothing) e
== evalPrimExp (\_ -> Nothing) (simplify e)
]
eval :: TestableExp -> Int64
eval (TestableExp e) = evalExp e
evalExp :: PrimExp VName -> Int64
evalExp (ValueExp (IntValue (Int64Value i))) = i
evalExp (BinOpExp (Add Int64 OverflowUndef) e1 e2) = evalExp e1 + evalExp e2
evalExp (BinOpExp (Sub Int64 OverflowUndef) e1 e2) = evalExp e1 - evalExp e2
evalExp (BinOpExp (Mul Int64 OverflowUndef) e1 e2) = evalExp e1 * evalExp e2
evalExp _ = undefined
add :: PrimExp VName -> PrimExp VName -> PrimExp VName
add = BinOpExp (Add Int64 OverflowUndef)
sub :: PrimExp VName -> PrimExp VName -> PrimExp VName
sub = BinOpExp (Sub Int64 OverflowUndef)
mul :: PrimExp VName -> PrimExp VName -> PrimExp VName
mul = BinOpExp (Mul Int64 OverflowUndef)
neg :: PrimExp VName -> PrimExp VName
neg = BinOpExp (Sub Int64 OverflowUndef) (val 0)
l :: Int -> PrimExp VName
l i = LeafExp (VName (nameFromString $ show i) i) (IntType Int64)
val :: Int64 -> PrimExp VName
val = ValueExp . IntValue . Int64Value
generateExp :: Gen (PrimExp VName)
generateExp = do
n <- getSize
if n <= 1
then val <$> arbitrary
else
oneof
[ scale (`div` 2) $ generateBinOp add,
scale (`div` 2) $ generateBinOp sub,
scale (`div` 2) $ generateBinOp mul,
scale (`div` 2) generateNeg,
val <$> arbitrary
]
generateBinOp :: (PrimExp VName -> PrimExp VName -> PrimExp VName) -> Gen (PrimExp VName)
generateBinOp op = do
t1 <- generateExp
op t1 <$> generateExp
generateNeg :: Gen (PrimExp VName)
generateNeg =
do neg <$> generateExp
newtype TestableExp = TestableExp (PrimExp VName)
deriving (Show)
instance Arbitrary TestableExp where
arbitrary = TestableExp <$> generateExp
|
