[Git][ghc/ghc][wip/spj-apporv-Oct24] Don't use a user SrcSpan on a Stmt expansoin

[Simon Peyton Jones (@simonpj)]

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


Commits:
b30ee4cc by Simon Peyton Jones at 2024-10-11T00:05:37+01:00
Don't use a user SrcSpan on a Stmt expansoin

- - - - -


3 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Gen/Do.hs
- testsuite/tests/typecheck/should_fail/tcfail128.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -519,14 +519,6 @@ data XXExprGhcRn
                                                    -- in `GHC.Tc.Gen.Do`
 
 
--- | Wrap a located expression with a `PopErrCtxt`
-mkPopErrCtxtExpr :: LHsExpr GhcRn -> HsExpr GhcRn
-mkPopErrCtxtExpr a = XExpr (PopErrCtxt a)
-
--- | Wrap a located expression with a PopSrcExpr with an appropriate location
-mkPopErrCtxtExprAt :: SrcSpanAnnA ->  LHsExpr GhcRn -> LHsExpr GhcRn
-mkPopErrCtxtExprAt loc a = L loc $ mkPopErrCtxtExpr a
-
 -- | Build an expression using the extension constructor `XExpr`,
 --   and the two components of the expansion: original expression and
 --   expanded expressions.
@@ -556,22 +548,6 @@ mkExpandedPatRn
 mkExpandedPatRn oPat flav eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigPat oPat flav
                                                          , xrn_expanded = eExpr })
 
--- | Build an expression using the extension constructor `XExpr`,
---   and the two components of the expansion: original do stmt and
---   expanded expression and associate it with a provided location
-mkExpandedStmtAt
-  :: Bool                 -- ^ Wrap this expansion with a pop?
-  -> SrcSpanAnnA          -- ^ Location for the expansion expression
-  -> ExprLStmt GhcRn      -- ^ source statement
-  -> HsDoFlavour          -- ^ the flavour of the statement
-  -> HsExpr GhcRn         -- ^ expanded expression
-  -> LHsExpr GhcRn        -- ^ suitably wrapped located 'XXExprGhcRn'
-mkExpandedStmtAt addPop loc oStmt flav eExpr
-  | addPop
-  = mkPopErrCtxtExprAt loc (L loc $ mkExpandedStmt oStmt flav eExpr)
-  | otherwise
-  = L loc $ mkExpandedStmt oStmt flav eExpr
-
 data XXExprGhcTc
   = WrapExpr        -- Type and evidence application and abstractions
       {-# UNPACK #-} !(HsWrap HsExpr)


=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -563,3 +563,29 @@ It stores the original statement (with location) and the expanded expression
   We hence use a tag `GenReason` in `Ghc.Tc.Origin`. When typechecking a `HsLam` in `Tc.Gen.Expr.tcExpr`
   the `match_ctxt` is set to a `StmtCtxt` if `GenOrigin` is a `DoExpansionOrigin`.
 -}
+
+
+-- | Wrap a located expression with a `PopErrCtxt`
+mkPopErrCtxtExpr :: LHsExpr GhcRn -> HsExpr GhcRn
+mkPopErrCtxtExpr a = XExpr (PopErrCtxt a)
+
+-- | Wrap a located expression with a PopSrcExpr with an appropriate location
+mkPopErrCtxtExprAt :: SrcSpanAnnA ->  LHsExpr GhcRn -> LHsExpr GhcRn
+mkPopErrCtxtExprAt _loc a = wrapGenSpan $ mkPopErrCtxtExpr a
+
+-- | Build an expression using the extension constructor `XExpr`,
+--   and the two components of the expansion: original do stmt and
+--   expanded expression and associate it with a provided location
+mkExpandedStmtAt
+  :: Bool                 -- ^ Wrap this expansion with a pop?
+  -> SrcSpanAnnA          -- ^ Location for the expansion expression
+  -> ExprLStmt GhcRn      -- ^ source statement
+  -> HsDoFlavour          -- ^ the flavour of the statement
+  -> HsExpr GhcRn         -- ^ expanded expression
+  -> LHsExpr GhcRn        -- ^ suitably wrapped located 'XXExprGhcRn'
+mkExpandedStmtAt addPop _loc oStmt flav eExpr
+  | addPop
+  = mkPopErrCtxtExprAt _loc (wrapGenSpan $ mkExpandedStmt oStmt flav eExpr)
+  | otherwise
+  = wrapGenSpan $ mkExpandedStmt oStmt flav eExpr
+


=====================================
testsuite/tests/typecheck/should_fail/tcfail128.hs
=====================================
@@ -11,10 +11,13 @@ import Data.Array.IArray as IA (Array,listArray)
 main :: IO ()
 main = do let sL = [1,4,6,3,2,5]
               dim = length sL
-              help :: [FlatVector]
+
+          let help :: [FlatVector]
               help = [listFlatVector (1,s) [0|i<-[1..s]]|s<-sL]
-              tmp :: Vector FlatVector
+
+          let tmp :: Vector FlatVector
               tmp = listVector (1,dim) help
+
           v <- thaw tmp
           return ()
 



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b30ee4cc02b99251f2b5957d2cc2e82428e4e7c3
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/20241010/6c640aa5/attachment-0001.html>