mirror of
https://github.com/grin-compiler/grin.git
synced 2024-10-26 08:41:51 +03:00
Revert "Revert "Reverted CSE test changes""
This reverts commit c5c1345b75
.
There was an accidental push to the remote master branch.
This commit is the only difference between the two branches.
This commit is contained in:
parent
68eba16d12
commit
66da2a5434
@ -4,12 +4,9 @@ module Transformations.Optimising.CSESpec where
|
||||
import Transformations.Optimising.CSE
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.PipelineExample
|
||||
import Pipeline.Pipeline hiding (pipeline)
|
||||
import Grin.TH
|
||||
import Test.Test hiding (newVar)
|
||||
import Test.Assertions
|
||||
import Grin.Syntax (Exp)
|
||||
import Grin.TypeEnv
|
||||
import Grin.TypeCheck
|
||||
import Transformations.EffectMap
|
||||
@ -18,16 +15,10 @@ import Transformations.EffectMap
|
||||
runTests :: IO ()
|
||||
runTests = hspec spec
|
||||
|
||||
pipelineSrcWithCtx :: ((TypeEnv, Exp) -> (TypeEnv, Exp)) ->
|
||||
TypeEnv -> Exp -> Exp ->
|
||||
[PipelineStep] -> Pipeline
|
||||
pipelineSrcWithCtx ctx tyEnv before after =
|
||||
pipelineSrc (snd $ ctx (tyEnv, before)) (snd $ ctx (tyEnv, after))
|
||||
cseOptNoEff (tyEnv, exp) = commonSubExpressionElimination tyEnv mempty exp
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
let csePipeline = [ T CommonSubExpressionElimination ]
|
||||
|
||||
testExprContext $ \ctx -> do
|
||||
it "Figure 4.34" $ do
|
||||
let teBefore = create $
|
||||
@ -59,7 +50,7 @@ spec = do
|
||||
(CInt b') <- pure (r' z')
|
||||
fun 3 4
|
||||
|]
|
||||
pipelineSrcWithCtx ctx teBefore before after csePipeline
|
||||
cseOptNoEff (ctx (teBefore, before)) `sameAs` (snd $ ctx (teBefore, after))
|
||||
|
||||
let te = emptyTypeEnv
|
||||
it "store - fetch" $ do
|
||||
@ -73,7 +64,7 @@ spec = do
|
||||
(CInt a1) <- pure (CInt 0)
|
||||
pure ()
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
cseOptNoEff (ctx (te, before)) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "store - fetch - update" $ do
|
||||
let before = [expr|
|
||||
@ -102,7 +93,7 @@ spec = do
|
||||
update p1 (CInt 1)
|
||||
pure (CInt 1)
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
cseOptNoEff (ctx (te, before)) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "store - update" $ do
|
||||
let before = [expr|
|
||||
@ -120,7 +111,7 @@ spec = do
|
||||
p2 <- store v1
|
||||
pure ()
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
cseOptNoEff (ctx (te, before)) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
let te = emptyTypeEnv
|
||||
it "fetch - update" $ do
|
||||
@ -133,7 +124,7 @@ spec = do
|
||||
v <- fetch p
|
||||
pure 1
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
cseOptNoEff (ctx (te, before)) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "constant" $ do
|
||||
let before = [expr|
|
||||
@ -160,7 +151,7 @@ spec = do
|
||||
(CInt i7) <- pure (CInt i6)
|
||||
pure v2
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
cseOptNoEff (ctx (te, before)) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "application" $ do
|
||||
let te = create $ mconcat
|
||||
@ -186,7 +177,7 @@ spec = do
|
||||
v4 <- _prim_int_add v2 v3
|
||||
pure v4
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
(cseOptNoEff (ctx (te, before))) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "case alternative tracking" $ do
|
||||
let before = [expr|
|
||||
@ -213,7 +204,7 @@ spec = do
|
||||
n4 <- pure n1
|
||||
pure n4
|
||||
|]
|
||||
pipelineSrcWithCtx ctx te before after csePipeline
|
||||
(cseOptNoEff (ctx (te, before))) `sameAs` (snd $ ctx (te, after))
|
||||
|
||||
it "no copy propagation of def arguments" $ do
|
||||
let before = [prog|
|
||||
@ -230,7 +221,9 @@ spec = do
|
||||
d <- pure c
|
||||
pure d
|
||||
|]
|
||||
pipelineSrc before after csePipeline
|
||||
let tyEnv = inferTypeEnv before
|
||||
effMap = effectMap (tyEnv, before)
|
||||
commonSubExpressionElimination tyEnv effMap before `sameAs` after
|
||||
|
||||
describe "bugfix" $ do
|
||||
it "do not memoize effectful functions" $ do
|
||||
@ -264,7 +257,9 @@ spec = do
|
||||
f <- funEff 2
|
||||
pure ()
|
||||
|]
|
||||
pipelineSrc before after csePipeline
|
||||
let tyEnv = inferTypeEnv before
|
||||
effMap = effectMap (tyEnv, before)
|
||||
commonSubExpressionElimination tyEnv effMap before `sameAs` after
|
||||
|
||||
it "do not remove effectful function from the rhs position of a bind" $ do
|
||||
let before = [prog|
|
||||
@ -281,4 +276,6 @@ spec = do
|
||||
_prim_int_print 1
|
||||
_prim_int_print 1
|
||||
|]
|
||||
pipelineSrc before after csePipeline
|
||||
let tyEnv = inferTypeEnv before
|
||||
effMap = effectMap (tyEnv, before)
|
||||
commonSubExpressionElimination tyEnv effMap before `sameAs` after
|
||||
|
Loading…
Reference in New Issue
Block a user