ES: added Evaluated and Trivial Case Elimination

Author: Anabra

grin/grin.cabal

@@ -146,6 +146,8 @@ library
     Transformations.ExtendedSyntax.GenerateEval
     Transformations.ExtendedSyntax.MangleNames
     Transformations.ExtendedSyntax.StaticSingleAssignment
+    Transformations.ExtendedSyntax.Optimising.EvaluatedCaseElimination
+    Transformations.ExtendedSyntax.Optimising.TrivialCaseElimination
 
     Transformations.BindNormalisation
     Transformations.CountVariableUse

grin/src/Transformations/ExtendedSyntax/Optimising/EvaluatedCaseElimination.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE LambdaCase, TupleSections #-}
+module Transformations.ExtendedSyntax.Optimising.EvaluatedCaseElimination where
+
+import Data.Functor.Foldable as Foldable
+import Grin.Grin
+
+evaluatedCaseElimination :: Exp -> Exp
+evaluatedCaseElimination = ana builder where
+  builder :: Exp -> ExpF Exp
+  builder = \case
+    ECase val alts | all (altBodyEQ $ SReturn val) alts -> SReturnF val
+    exp -> project exp
+
+  altBodyEQ :: Exp -> Alt -> Bool
+  altBodyEQ exp (Alt _cpat body) = exp == body

grin/src/Transformations/ExtendedSyntax/Optimising/TrivialCaseElimination.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE LambdaCase, TupleSections #-}
+module Transformations.ExtendedSyntax.Optimising.TrivialCaseElimination where
+
+import Data.Functor.Foldable as Foldable
+import Grin.Grin
+import Transformations.Util
+
+trivialCaseElimination :: Exp -> Exp
+trivialCaseElimination = ana builder where
+  builder :: Exp -> ExpF Exp
+  builder = \case
+    ECase val [Alt DefaultPat body] -> SBlockF body
+    ECase val [Alt cpat body]       -> SBlockF $ EBind (SReturn val)  (cpatToLPat cpat) body
+    exp -> project exp