[Git][ghc/ghc][wip/spj-apporv-Oct24] Adapt locations for do-blocks

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC


Commits:
0753130c by Simon Peyton Jones at 2025-03-03T15:23:33+00:00
Adapt locations for do-blocks

- - - - -


1 changed file:

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


Changes:

=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -255,9 +255,10 @@ mk_failable_expr doFlav lpat expr@(L _exprloc _) fail_op =
        else wrapGenSpan <$> mk_fail_block doFlav lpat expr fail_op
      }
 
--- makes the fail block with a given fail_op
 mk_fail_block :: HsDoFlavour
               -> LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (HsExpr GhcRn)
+-- (mk_fail_block (L ploc pat) rhs fail_op) makes
+--      \x. case x of { (L ploc pat) -> rhs; _ -> fail_op "pattern match failure..."  }
 mk_fail_block doFlav pat@(L ploc _) e (Just (SyntaxExprRn fail_op)) =
   do  dflags <- getDynFlags
       return $ HsLam noAnn LamCases $ mkMatchGroup (doExpansionOrigin doFlav) -- \
@@ -267,11 +268,11 @@ mk_fail_block doFlav pat@(L ploc _) e (Just (SyntaxExprRn fail_op)) =
         where
           fail_alt_case :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> LMatch GhcRn (LHsExpr GhcRn)
           fail_alt_case dflags pat fail_op = genHsCaseAltDoExp doFlav (L ploc $ WildPat noExtField) $
-                                             L ploc (fail_op_expr dflags pat fail_op)
+                                             L generatedLoc (fail_op_expr dflags pat fail_op)
 
           fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
           fail_op_expr dflags pat fail_op
-            = mkExpandedPatRn pat doFlav $
+            = mkExpandedPatRn pat doFlav $  xxx get rid of this!
                     genHsApp fail_op (mk_fail_msg_expr dflags pat)
 
           mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0753130cda9a59b573942f06868a1b89da20a0b3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0753130cda9a59b573942f06868a1b89da20a0b3
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/20250303/34368ee6/attachment-0001.html>