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.

grin/test/Transformations/Optimising/CSESpec.hs

@@ -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