Simplify away single-use let bindings

Author: isovector

plugins/hls-tactics-plugin/src/Wingman/GHC.hs

@@ -3,6 +3,7 @@
 
 module Wingman.GHC where
 
+import           Bag (bagToList)
 import           ConLike
 import           Control.Applicative (empty)
 import           Control.Monad.State
@@ -196,6 +197,15 @@ pattern AMatch ctx pats body <-
         }
 
 
+pattern SingleLet :: IdP GhcPs -> [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
+pattern SingleLet bind pats val expr <-
+  HsLet _
+    (L _ (HsValBinds _
+      (ValBinds _ (bagToList ->
+        [(L _ (FunBind _ (L _ bind) (MG _ (L _ [L _ (AMatch _ pats val)]) _) _ _))]) _)))
+    (L _ expr)
+
+
 ------------------------------------------------------------------------------
 -- | A pattern over the otherwise (extremely) messy AST for lambdas.
 pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs

plugins/hls-tactics-plugin/src/Wingman/Simplify.hs

@@ -11,7 +11,7 @@ import Development.IDE.GHC.Compat
 import GHC.SourceGen (var)
 import GHC.SourceGen.Expr (lambda)
 import Wingman.CodeGen.Utils
-import Wingman.GHC (containsHsVar, fromPatCompat)
+import Wingman.GHC (containsHsVar, fromPatCompat, pattern SingleLet)
 
 
 ------------------------------------------------------------------------------
@@ -30,6 +30,7 @@ pattern Lambda pats body <-
     Lambda pats body = lambda pats body
 
 
+
 ------------------------------------------------------------------------------
 -- | Simlify an expression.
 simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
@@ -41,6 +42,7 @@ simplify
     [ simplifyEtaReduce
     , simplifyRemoveParens
     , simplifyCompose
+    , simplifySingleLet
     ])
 
 
@@ -68,6 +70,14 @@ simplifyEtaReduce = mkT $ \case
     Lambda pats f
   x -> x
 
+------------------------------------------------------------------------------
+-- | Perform an eta reduction. For example, transforms @\x -> (f g) x@ into
+-- @f g@.
+simplifySingleLet :: GenericT
+simplifySingleLet = mkT $ \case
+  SingleLet bind [] val (HsVar _ (L _ a)) | a == bind -> val
+  x -> x
+
 
 ------------------------------------------------------------------------------
 -- | Perform an eta-reducing function composition. For example, transforms

plugins/hls-tactics-plugin/test/golden/MetaCataCollapseUnary.expected.hs

@@ -4,5 +4,5 @@ class Yo f where
     yo :: f x -> Int
 
 instance (Yo f) => Yo (M1 _1 _2 f) where
-  yo (M1 fx) = let fx_c = yo fx in fx_c
+  yo (M1 fx) = yo fx