[Git][ghc/ghc][wip/expand-do] use the correct bind operator for qualified rebindable rec do expansions

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC


Commits:
65df79ab by Apoorv Ingle at 2023-06-02T08:53:16-05:00
use the correct bind operator for qualified rebindable rec do expansions

- - - - -


1 changed file:

- compiler/GHC/Tc/Gen/Match.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -43,7 +43,7 @@ import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC
                                        , tcCheckMonoExpr, tcCheckMonoExprNC
                                        , tcCheckPolyExpr )
 
-import GHC.Rename.Utils ( bindLocalNames, genHsApp, genLHsVar, wrapGenSpan )
+import GHC.Rename.Utils ( bindLocalNames, genHsApp, wrapGenSpan )
 import GHC.Tc.Errors.Types
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Env
@@ -67,7 +67,6 @@ import GHC.Hs
 
 import GHC.Builtin.Types
 import GHC.Builtin.Types.Prim
-import GHC.Builtin.Names (bindMName)
 
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
@@ -1271,6 +1270,7 @@ expand_do_stmts do_or_lc
   ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts
                       , recS_later_ids = later_ids  -- forward referenced local ids
                       , recS_rec_ids = local_ids     -- ids referenced outside of the rec block
+                      , recS_bind_fn = SyntaxExprRn bind_fun   -- the (>>=) expr
                       , recS_mfix_fn = SyntaxExprRn mfix_fun   -- the `mfix` expr
                       , recS_ret_fn  = SyntaxExprRn return_fun -- the `return` expr
                                                           -- use it explicitly
@@ -1286,7 +1286,7 @@ expand_do_stmts do_or_lc
 --                                                 ; return (local_only_ids ++ later_ids) } ))
 --                              (\ [ local_only_ids ++ later_ids ] -> stmts')
   do expand_stmts <- expand_do_stmts do_or_lc lstmts
-     return $ mkHsApps (genLHsVar bindMName)                            -- (Prelude.>>=)
+     return $ mkHsApps (wrapGenSpan bind_fun)                           -- (>>=)
                       [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr           -- (mfix (do block))
                       , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ]                --        (\ x ->
                                        (genPopSrcSpanExpr expand_stmts)      --           stmts')



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65df79ab5c13e2abc80f260930b2083e90325225

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65df79ab5c13e2abc80f260930b2083e90325225
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230602/1b709bd0/attachment-0001.html>