Use trees that grow for rebindable operators for `<-` binds

Also add more documentation.

1 files changed, 10 insertions, 12 deletions

diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 976248ae53..806758313a 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -709,12 +709,12 @@ addTickStmt _isGuard (LastStmt x e noret ret) = do
                 (addTickLHsExpr e)
                 (pure noret)
                 (addTickSyntaxExpr hpcSrcSpan ret)
-addTickStmt _isGuard (BindStmt x pat e bind fail) = do
-        liftM4 (BindStmt x)
-                (addTickLPat pat)
-                (addTickLHsExprRHS e)
+addTickStmt _isGuard (BindStmt (bind, ty, fail) pat e) = do
+        liftM4 (\b f -> BindStmt (b, ty, f))
                 (addTickSyntaxExpr hpcSrcSpan bind)
                 (mapM (addTickSyntaxExpr hpcSrcSpan) fail)
+                (addTickLPat pat)
+                (addTickLHsExprRHS e)
 addTickStmt isGuard (BodyStmt x e bind' guard') = do
         liftM3 (BodyStmt x)
                 (addTick isGuard e)
@@ -763,12 +763,12 @@ addTickApplicativeArg
 addTickApplicativeArg isGuard (op, arg) =
   liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
  where
-  addTickArg (ApplicativeArgOne x pat expr isBody fail) =
-    (ApplicativeArgOne x)
-      <$> addTickLPat pat
+  addTickArg (ApplicativeArgOne m_fail pat expr isBody) =
+    ApplicativeArgOne
+      <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail
+      <*> addTickLPat pat
       <*> addTickLHsExpr expr
       <*> pure isBody
-      <*> mapM (addTickSyntaxExpr hpcSrcSpan) fail
   addTickArg (ApplicativeArgMany x stmts ret pat) =
     (ApplicativeArgMany x)
       <$> addTickLStmts isGuard stmts
@@ -938,12 +938,10 @@ addTickLCmdStmts' lstmts res
         binders = collectLStmtsBinders lstmts
 
 addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
-addTickCmdStmt (BindStmt x pat c bind fail) = do
-        liftM4 (BindStmt x)
+addTickCmdStmt (BindStmt x pat c) = do
+        liftM2 (BindStmt x)
                 (addTickLPat pat)
                 (addTickLHsCmd c)
-                (return bind)
-                (return fail)
 addTickCmdStmt (LastStmt x c noret ret) = do
         liftM3 (LastStmt x)
                 (addTickLHsCmd c)