[Git][ghc/ghc][wip/expand-do] - Note changes. Making expansion example a bit more complex

[Apoorv Ingle (@ani)]

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


Commits:
7742deac by Apoorv Ingle at 2023-11-06T21:15:49+01:00
- Note changes. Making expansion example a bit more complex

- - - - -


3 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/Tc/Gen/Do.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -1425,7 +1425,7 @@ instance (OutputableBndrId p) => Outputable (HsCmdTop (GhcPass p)) where
 -}
 
 type instance XMG         GhcPs b = Origin
-type instance XMG         GhcRn b = Origin
+type instance XMG         GhcRn b = Origin -- See Note [Generated code and pattern-match checking]
 type instance XMG         GhcTc b = MatchGroupTc
 
 data MatchGroupTc


=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -68,7 +68,7 @@ import GHC.HsToCore.Monad
 import GHC.Data.Bag
 import GHC.Data.OrdList
 
-import Control.Monad (when, forM_)
+import Control.Monad (when, unless, forM_)
 import qualified Data.Semigroup as Semi
 import Data.List.NonEmpty ( NonEmpty(..) )
 import qualified Data.List.NonEmpty as NE
@@ -191,7 +191,7 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do
       result  <- {-# SCC "checkMatchGroup" #-}
                  unCA (checkMatchGroup matches) missing
       tracePm "}: " (ppr (cr_uncov result))
-      when (not (isDoExpansionGenerated origin)) -- Generated code shouldn't emit overlapping warnings
+      unless (isDoExpansionGenerated origin) -- Do expansion generated code shouldn't emit overlapping warnings
         ({-# SCC "formatReportWarnings" #-}
         formatReportWarnings ReportMatchGroup ctxt vars result)
       return (NE.toList (ldiMatchGroup (cr_ret result)))


=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -410,15 +410,17 @@ It stores the original statement (with location) and the expanded expression
   -----------------------------
   For example, the `do`-block
 
-      do { e1;  e2 }
+      do { e1;  e2; e3 }
 
   expands (ignoring the location info) to
 
-      ‹ExpandedThingRn do { e1; e2 }›                               -- Original Do Expression
+      ‹ExpandedThingRn do { e1; e2; e3 }›                        -- Original Do Expression
                                                                  -- Expanded Do Expression
-          (‹ExpandedThingRn e1›                                     -- Original Statement
-                        ({(>>) e1}                               -- Expanded Expression
-                            ‹PopErrCtxt› (‹ExpandedThingRn e2› {e2})))
+          (‹ExpandedThingRn e1›                                  -- Original Statement
+               ({(>>) e1}                                        -- Expanded Expression
+                  ‹PopErrCtxt› (‹ExpandedThingRn e2›
+                         ({(>>) e2}
+                            ‹PopErrCtxt› (‹ExpandedThingRn e3› {e3})))))
 
   * Whenever the typechecker steps through an `ExpandedThingRn`,
     we push the original statement in the error context, set the error location to the
@@ -457,9 +459,9 @@ It stores the original statement (with location) and the expanded expression
   expands (ignoring the location information) to
 
      ‹ExpandedThingRn do{ p <- e1; e2 }›                                      -- Original Do Expression
-                                                                           --
+                                                                              --
          (‹ExpandedThingRn (p <- e1)›                                         -- Original Statement
-                        (((>>=) e1)                                        -- Expanded Expression
+                        (((>>=) e1)                                           -- Expanded Expression
                            ‹PopErrCtxt› ((\ p -> ‹ExpandedThingRn (e2)› e2)))
          )
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7742deacd8eaa5d52b5f774139c54308b6f923f9

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7742deacd8eaa5d52b5f774139c54308b6f923f9
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/20231106/fb5accff/attachment-0001.html>