[Git][ghc/ghc][wip/az/ghc-9.10-backports-1] EPA: Provide correct span for PatBind
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Apr 21 11:39:55 UTC 2024
Alan Zimmerman pushed to branch wip/az/ghc-9.10-backports-1 at Glasgow Haskell Compiler / GHC
Commits:
7d6ae7aa by Alan Zimmerman at 2024-04-21T11:39:48+01:00
EPA: Provide correct span for PatBind
And remove unused parameter in checkPatBind
Contributes to #24669
(cherry picked from commit c90c60390aa3949b400f26ee0534273c56e19005)
- - - - -
6 changed files:
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/linear/should_fail/LinearLet6.stderr
- testsuite/tests/linear/should_fail/LinearLet7.stderr
Changes:
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -116,7 +116,7 @@ type instance XFunBind (GhcPass pL) GhcTc = (HsWrapper, [CoreTickish])
-- type Int -> forall a'. a' -> a'
-- Notice that the coercion captures the free a'.
-type instance XPatBind GhcPs (GhcPass pR) = [AddEpAnn]
+type instance XPatBind GhcPs (GhcPass pR) = NoExtField
type instance XPatBind GhcRn (GhcPass pR) = NameSet -- See Note [Bind free vars]
type instance XPatBind GhcTc (GhcPass pR) =
( Type -- Type of the GRHSs
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2585,7 +2585,7 @@ decl_no_th :: { LHsDecl GhcPs }
; !cs <- getCommentsFor l
; return $! (sL (commentsA l cs) $ ValD noExtField r) } }
| PREFIX_PERCENT atype infixexp opt_sig rhs {% runPV (unECP $3) >>= \ $3 ->
- do { let { l = comb2 $3 $> }
+ do { let { l = comb2 $1 $> }
; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;
-- parses bindings of the form %p x or
-- %p x :: sig
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1323,7 +1323,7 @@ checkValDef loc lhs (mult, Just (sigAnn, sig)) grhss
-- x :: ty = rhs parses as a *pattern* binding
= do lhs' <- runPV $ mkHsTySigPV (combineLocsA lhs sig) lhs sig [sigAnn]
>>= checkLPat
- checkPatBind loc [] lhs' grhss mult
+ checkPatBind loc lhs' grhss mult
checkValDef loc lhs (mult_ann, Nothing) grhss
| HsNoMultAnn{} <- mult_ann
@@ -1334,12 +1334,12 @@ checkValDef loc lhs (mult_ann, Nothing) grhss
fun is_infix pats grhss
Nothing -> do
lhs' <- checkPattern lhs
- checkPatBind loc [] lhs' grhss mult_ann }
+ checkPatBind loc lhs' grhss mult_ann }
checkValDef loc lhs (mult_ann, Nothing) ghrss
-- %p x = rhs parses as a *pattern* binding
= do lhs' <- checkPattern lhs
- checkPatBind loc [] lhs' ghrss mult_ann
+ checkPatBind loc lhs' ghrss mult_ann
checkFunBind :: SrcStrictness
-> SrcSpan
@@ -1377,15 +1377,14 @@ makeFunBind fn ms
-- See Note [FunBind vs PatBind]
checkPatBind :: SrcSpan
- -> [AddEpAnn]
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> HsMultAnn GhcPs
-> P (HsBind GhcPs)
-checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
+checkPatBind loc (L _ (BangPat ans (L _ (VarPat _ v))))
(L _match_span grhss) (HsNoMultAnn _)
= return (makeFunBind v (L (noAnnSrcSpan loc)
- [L (noAnnSrcSpan loc) (m (ans++annsIn) v)]))
+ [L (noAnnSrcSpan loc) (m ans v)]))
where
m a v = Match { m_ext = a
, m_ctxt = FunRhs { mc_fun = v
@@ -1394,8 +1393,8 @@ checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
, m_pats = []
, m_grhss = grhss }
-checkPatBind _loc annsIn lhs (L _ grhss) mult = do
- return (PatBind annsIn lhs mult grhss)
+checkPatBind _loc lhs (L _ grhss) mult = do
+ return (PatBind noExtField lhs mult grhss)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -218,7 +218,7 @@ cvtDec (TH.ValD pat body ds)
; returnJustLA $ Hs.ValD noExtField $
PatBind { pat_lhs = pat'
, pat_rhs = GRHSs emptyComments body' ds'
- , pat_ext = noAnn
+ , pat_ext = noExtField
, pat_mult = HsNoMultAnn noExtField
} }
=====================================
testsuite/tests/linear/should_fail/LinearLet6.stderr
=====================================
@@ -13,7 +13,7 @@ LinearLet6.hs:10:3: error: [GHC-18872]
where
(Just y) = x
-LinearLet6.hs:15:14: error: [GHC-18872]
+LinearLet6.hs:15:11: error: [GHC-18872]
• Couldn't match type ‘Many’ with ‘One’
arising from a non-linear pattern ‘Just y’
(non-variable lazy pattern aren't linear)
=====================================
testsuite/tests/linear/should_fail/LinearLet7.stderr
=====================================
@@ -1,14 +1,14 @@
-LinearLet7.hs:6:14: error: [GHC-18872]
+LinearLet7.hs:6:11: error: [GHC-18872]
• Couldn't match type ‘Many’ with ‘One’
- arising from multiplicity of ‘g’
- • In a pattern binding: g = \ y -> g y
- In the expression: let %1 g = \ y -> ... in g x
+ arising from a non-linear pattern ‘_’
+ (non-variable pattern bindings that have been generalised aren't linear)
+ • In the expression: let %1 g = \ y -> ... in g x
In an equation for ‘f’: f x = let %1 g = ... in g x
LinearLet7.hs:6:14: error: [GHC-18872]
• Couldn't match type ‘Many’ with ‘One’
- arising from a non-linear pattern ‘_’
- (non-variable pattern bindings that have been generalised aren't linear)
- • In the expression: let %1 g = \ y -> ... in g x
+ arising from multiplicity of ‘g’
+ • In a pattern binding: g = \ y -> g y
+ In the expression: let %1 g = \ y -> ... in g x
In an equation for ‘f’: f x = let %1 g = ... in g x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d6ae7aa4def7131d281040e6b0e600f84cd1bb2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d6ae7aa4def7131d281040e6b0e600f84cd1bb2
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/20240421/6b392941/attachment-0001.html>
More information about the ghc-commits
mailing list