ES: added tests for Evaluated and Trivial Case Elimination

Author: Anabra

grin/grin.cabal

@@ -299,6 +299,8 @@ test-suite grin-test
                      Transformations.ExtendedSyntax.ConversionSpec
                      Transformations.ExtendedSyntax.MangleNamesSpec
                      Transformations.ExtendedSyntax.StaticSingleAssignmentSpec
+                     Transformations.ExtendedSyntax.Optimising.EvaluatedCaseEliminationSpec
+                     Transformations.ExtendedSyntax.Optimising.TrivialCaseEliminationSpec
 
                      Transformations.Simplifying.RegisterIntroductionSpec
                      Transformations.Simplifying.CaseSimplificationSpec

grin/test/Transformations/ExtendedSyntax/Optimising/EvaluatedCaseEliminationSpec.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-}
+module Transformations.ExtendedSyntax.Optimising.EvaluatedCaseEliminationSpec where
+
+import Transformations.Optimising.EvaluatedCaseElimination
+
+import Test.Hspec
+import Grin.TH
+import Test.Test hiding (newVar)
+import Test.Assertions
+
+
+runTests :: IO ()
+runTests = hspec spec
+
+spec :: Spec
+spec = do
+  testExprContextE $ \ctx -> do
+    it "Figure 4.22" $ do
+      let before = [expr|
+          case v of
+            (CLeft l)  -> pure v
+            (CRight r) -> pure v
+        |]
+      let after = [expr|
+          pure v
+        |]
+      evaluatedCaseElimination (ctx before) `sameAs` (ctx after)
+
+    it "default case" $ do
+      let before = [expr|
+          case v of
+            (CLeft l)   -> pure v
+            #default    -> pure v
+        |]
+      let after = [expr|
+          pure v
+        |]
+      evaluatedCaseElimination (ctx before) `sameAs` (ctx after)

grin/test/Transformations/ExtendedSyntax/Optimising/TrivialCaseEliminationSpec.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-}
+module Transformations.ExtendedSyntax.Optimising.TrivialCaseEliminationSpec where
+
+import Transformations.Optimising.TrivialCaseElimination
+
+import Test.Hspec
+import Grin.TH
+import Test.Test hiding (newVar)
+import Test.Assertions
+
+
+runTests :: IO ()
+runTests = hspec spec
+
+spec :: Spec
+spec = do
+  testExprContextE $ \ctx -> do
+    it "Figure 4.24" $ do
+      let before = [expr|
+          case v of
+            (Ffun a1 a2 a3) -> fun a1 a2 a3
+        |]
+      let after = [expr|
+          do
+            (Ffun a1 a2 a3) <- pure v
+            fun a1 a2 a3
+        |]
+      trivialCaseElimination (ctx before) `sameAs` (ctx after)
+
+    it "bypass" $ do
+      let before = [expr|
+          case v of
+            (Ffun1 a1 a2 a3) -> fun1 a1 a2 a3
+            #default -> pure 2
+        |]
+      let after = [expr|
+          case v of
+            (Ffun1 a1 a2 a3) -> fun1 a1 a2 a3
+            #default -> pure 2
+        |]
+      trivialCaseElimination (ctx before) `sameAs` (ctx after)
+
+    it "default alternative" $ do
+      let before = [expr|
+          case v of
+            #default -> pure 2
+        |]
+      let after = [expr|
+          do
+            pure 2
+        |]
+      trivialCaseElimination (ctx before) `sameAs` (ctx after)