Skip to content

Commit

Permalink
ES: SDVE tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@Anabra
Anabra committed Jan 18, 2020
1 parent 21c5e9c commit 698fde2
Showing 1 changed file with 140 additions and 115 deletions.
255 changes: 140 additions & 115 deletions grin/test/Transformations/ExtendedSyntax/Optimising/SimpleDeadVariableEliminationSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,14 @@
module Transformations.ExtendedSyntax.Optimising.SimpleDeadVariableEliminationSpec where

import Transformations.ExtendedSyntax.Optimising.SimpleDeadVariableElimination
import Transformations.EffectMap
import Grin.TypeCheck
import Transformations.ExtendedSyntax.EffectMap

import Test.Hspec
import Grin.TH
import Grin.PrimOpsPrelude
import Test.Test hiding (newVar)
import Test.Assertions

import Test.ExtendedSyntax.Assertions
import Grin.ExtendedSyntax.TH
import Grin.ExtendedSyntax.PrimOpsPrelude
import Grin.ExtendedSyntax.TypeCheck


runTests :: IO ()
Expand All @@ -18,7 +18,7 @@ runTests = hspec spec

spec :: Spec
spec = do
describe "bugs" $ do
describe "Bugs" $ do
it "keep blocks" $ do
let before = withPrimPrelude [prog|
grinMain =
Expand All @@ -27,25 +27,31 @@ spec = do
"unboxed.C\"GHC.Prim.Unit#\".0" <- do
result_Main.main1.0.0.0 <- pure (P1Main.main1.closure.0)
apply.unboxed2 $ result_Main.main1.0.0.0
_prim_int_print $ 0
k0 <- pure 0
_prim_int_print $ k0

apply.unboxed2 p.1.X =
do
(P1Main.main1.closure.0) <- pure p.1.X
_prim_int_print $ 12
store (F"GHC.Tuple.()")
(P1Main.main1.closure.0) @ v0 <- pure p.1.X
k1 <- pure 12
_1 <- _prim_int_print $ k1
n0 <- pure (F"GHC.Tuple.()")
store n0
|]
let after = withPrimPrelude [prog|
grinMain =
"unboxed.C\"GHC.Prim.Unit#\".0" <- do
result_Main.main1.0.0.0 <- pure (P1Main.main1.closure.0)
apply.unboxed2 $ result_Main.main1.0.0.0
_prim_int_print $ 0
k0 <- pure 0
_prim_int_print $ k0

apply.unboxed2 p.1.X =
do
_prim_int_print $ 12
store (F"GHC.Tuple.()")
k1 <- pure 12
_1 <- _prim_int_print $ k1
n0 <- pure (F"GHC.Tuple.()")
store n0
|]
let tyEnv = inferTypeEnv before
effMap = effectMap (tyEnv, before)
Expand All @@ -55,29 +61,35 @@ spec = do
it "do not remove effectful case" $ do
let before = withPrimPrelude [prog|
sideeff s1 =
s2 <- _prim_int_add s1 1
s2 <- _prim_int_add s1 s1
_prim_int_print s2

grinMain =
y <- pure (CInt 0)
x <- case y of
(CInt x1) -> sideeff x1
pure 1 -- pure (CInt 1)
(CFloat y1) -> y2 <- _prim_int_add 1 2
pure 2 -- pure (CInt y2)
k1 <- pure 0
n0 <- pure (CInt k1)
x <- case n0 of
(CInt x1) @ alt1 ->
_1 <- sideeff x1
pure 1 -- pure (CInt 1)
(CFloat y1) @ alt2 ->
y2 <- _prim_int_add k1 k1
pure 2 -- pure (CInt y2)
pure ()
|]
let after = withPrimPrelude [prog|
sideeff s1 =
s2 <- _prim_int_add s1 1
s2 <- _prim_int_add s1 s1
_prim_int_print s2

grinMain =
y <- pure (CInt 0)
x <- case y of
(CInt x1) -> sideeff x1
pure 1
(CFloat y1) -> pure 2
k1 <- pure 0
n0 <- pure (CInt k1)
x <- case n0 of
(CInt x1) @ alt1 ->
_1 <- sideeff x1
pure 1
(CFloat y1) @ alt2 ->
pure 2
pure ()
|]
let tyEnv = inferTypeEnv before
Expand All @@ -88,18 +100,22 @@ spec = do
it "do not remove effectful case 2" $ do
let before = withPrimPrelude [prog|
grinMain =
y <- pure (CInt #"str")
k0 <- pure #"str"
y <- pure (CInt k0)
x <- case y of
(CInt x1) -> _prim_string_print x1
pure 1 -- pure (CInt 1)
(CInt x1) @ alt1 ->
_1 <- _prim_string_print x1
pure 1 -- pure (CInt 1)
pure ()
|]
let after = withPrimPrelude [prog|
grinMain =
y <- pure (CInt #"str")
k0 <- pure #"str"
y <- pure (CInt k0)
x <- case y of
(CInt x1) -> _prim_string_print x1
pure 1
(CInt x1) @ alt1 ->
_1 <- _prim_string_print x1
pure 1
pure ()
|]
let tyEnv = inferTypeEnv before
Expand All @@ -115,7 +131,8 @@ spec = do
i1 <- pure 1
n1 <- pure (CNode i1)
p1 <- store n1
p2 <- store (CNode p1)
n2 <- pure (CNode p1)
p2 <- store n2
pure 0
|]
let after = [prog|
Expand All @@ -133,18 +150,19 @@ spec = do
i1 <- pure 1
n1 <- pure (CNode i1)
p1 <- store n1
p2 <- store (CNode p1)
_prim_int_print i1
n2 <- pure (CNode p1)
p2 <- store n2
_1 <- _prim_int_print i1
i2 <- case n1 of
1 -> pure 2
2 -> pure 3
#default -> pure 4
1 @ alt1 -> pure 2
2 @ alt2 -> pure 3
#default @ alt3 -> pure 4
pure 0
|]
let after = withPrimPrelude [prog|
grinMain =
i1 <- pure 1
_prim_int_print i1
_1 <- _prim_int_print i1
pure 0
|]
let tyEnv = inferTypeEnv before
Expand All @@ -158,23 +176,24 @@ spec = do
i1 <- pure 1
n1 <- pure (CNode i1)
p1 <- store n1
p2 <- store (CNode p1)
_prim_int_print i1
case n1 of
1 -> pure ()
2 -> _prim_int_print 3
#default -> pure ()
n2 <- pure (CNode p1)
p2 <- store n2
_1 <- _prim_int_print i1
_2 <- case n1 of
1 @ alt1 -> pure ()
2 @ alt2 -> _prim_int_print i1
#default @ alt3 -> pure ()
pure 0
|]
let after = withPrimPrelude [prog|
grinMain =
i1 <- pure 1
n1 <- pure (CNode i1)
_prim_int_print i1
case n1 of
1 -> pure ()
2 -> _prim_int_print 3
#default -> pure ()
_1 <- _prim_int_print i1
_2 <- case n1 of
1 @ alt1 -> pure ()
2 @ alt2 -> _prim_int_print i1
#default @ alt3 -> pure ()
pure 0
|]
let tyEnv = inferTypeEnv before
Expand All @@ -190,26 +209,26 @@ spec = do
p1 <- store n1
n2 <- pure (CNode p1)
p2 <- store n2
_prim_int_print i1
case n1 of
1 ->
_1 <- _prim_int_print i1
_2 <- case n1 of
1 @ alt1 ->
i2 <- case n2 of
0 -> pure 1
#default -> pure 2
0 @ alt11 -> pure 1
#default @ alt12 -> pure 2
pure ()
2 -> _prim_int_print 3
#default -> pure ()
2 @ alt2 -> _prim_int_print i1
#default @ alt3 -> pure ()
pure 0
|]
let after = withPrimPrelude [prog|
grinMain =
i1 <- pure 1
n1 <- pure (CNode i1)
_prim_int_print i1
case n1 of
1 -> pure ()
2 -> _prim_int_print 3
#default -> pure ()
_1 <- _prim_int_print i1
_2 <- case n1 of
1 @ alt1 -> pure ()
2 @ alt2 -> _prim_int_print i1
#default @ alt3 -> pure ()
pure 0
|]
let tyEnv = inferTypeEnv before
Expand All @@ -221,10 +240,10 @@ spec = do
let before = [prog|
grinMain =
i1 <- pure 1
(CNode i2) <- pure (CNode i1)
(CNode i3) <- pure (CNode i1)
(CNode i2) @ v1 <- pure (CNode i1)
(CNode i3) @ v2 <- pure (CNode i1)
n1 <- pure (CNode i2)
(CNode i4) <- pure n1
(CNode i4) @ v3 <- pure n1
pure i1
|]
let after = [prog|
Expand All @@ -240,14 +259,15 @@ spec = do
it "pattern match" $ do
let before = [prog|
grinMain =
n1 <- pure (CNode 0)
(CNode i3) <- pure n1
(CNil) <- pure (CNil)
(CUnit) <- pure (CUnit)
i1 <- pure 0
n1 <- pure (CNode i1)
(CNode i3) @ v1 <- pure n1
(CNil) @ v2 <- pure (CNil)
(CUnit) @ v3 <- pure (CUnit)
n2 <- pure (CNode i3)
(CNode i4) <- pure (CNode i3)
(CNode i5) <- pure n2
(CNode i6) <- pure n2
(CNode i4) @ v4 <- pure (CNode i3)
(CNode i5) @ v5 <- pure n2
(CNode i6) @ v6 <- pure n2
pure 0
|]
let after = [prog|
Expand All @@ -259,45 +279,50 @@ spec = do
dveExp = simpleDeadVariableElimination effMap before
dveExp `sameAs` after

describe "interprocedural DVE regression tests" $ do
it "Not explicitly covered alternatives trigger undefined replacements" $ do
let before = [prog|
grinMain =
v0 <- _prim_int_add 1 1
v1 <- case v0 of
2 ->
v2 <- _prim_int_lt 1 3
v3 <- case v2 of
#False -> pure v0
#True -> pure 1
case v3 of
0 -> pure (CGT)
1 -> pure (CLT)
1 -> pure (CEQ)
-- If #default is changed to explicit alternatives the undefineds are not introduced.
-- Undefineds are introduced for missing alternatives too.
case v1 of
(CEQ) -> _prim_int_print 1
#default -> _prim_int_print 2
|]
let after = [prog|
grinMain =
v0 <- _prim_int_add 1 1
v1 <- case v0 of
2 ->
v2 <- _prim_int_lt 1 3
v3 <- case v2 of
#False -> pure v0
#True -> pure 1
case v3 of
0 -> pure (CGT)
1 -> pure (CLT)
1 -> pure (CEQ)
case v1 of
(CEQ) -> _prim_int_print 1
#default -> _prim_int_print 2
|]
let tyEnv = inferTypeEnv before
effMap = effectMap (tyEnv, before)
dveExp = simpleDeadVariableElimination effMap before
dveExp `sameAs` after
-- QUESTION: Does this belong here, or to DeadVariableEliminationSpec?
describe "Interprocedural DVE regression tests" $ do
it "not explicitly covered alternatives trigger undefined replacements" $ do
let before = withPrimPrelude [prog|
grinMain =
one <- pure 1
two <- pure 2
v0 <- _prim_int_add one one
v1 <- case v0 of
2 @ alt1 ->
v2 <- _prim_int_lt one two
v3 <- case v2 of
#False @ alt11 -> pure v0
#True @ alt12 -> pure 1
case v3 of
0 @ alt13 -> pure (CGT)
1 @ alt14 -> pure (CLT)
1 @ alt2 -> pure (CEQ)
-- If #default is changed to explicit alternatives the undefineds are not introduced.
-- Undefineds are introduced for missing alternatives too.
case v1 of
(CEQ) @ alt3 -> _prim_int_print one
#default @ alt4 -> _prim_int_print two
|]
let after = withPrimPrelude [prog|
grinMain =
one <- pure 1
two <- pure 2
v0 <- _prim_int_add one one
v1 <- case v0 of
2 @ alt1 ->
v2 <- _prim_int_lt one two
v3 <- case v2 of
#False @ alt11 -> pure v0
#True @ alt12 -> pure 1
case v3 of
0 @ alt13 -> pure (CGT)
1 @ alt14 -> pure (CLT)
1 @ alt2 -> pure (CEQ)
case v1 of
(CEQ) @ alt3 -> _prim_int_print one
#default @ alt4 -> _prim_int_print two
|]
let tyEnv = inferTypeEnv before
effMap = effectMap (tyEnv, before)
dveExp = simpleDeadVariableElimination effMap before
dveExp `sameAs` after

0 comments on commit 698fde2

Please sign in to comment.