[Git][ghc/ghc][wip/az/ghc-9.10-backports-1] EPA: Fix span for PatBuilderAppType
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Apr 21 12:48:57 UTC 2024
Alan Zimmerman pushed to branch wip/az/ghc-9.10-backports-1 at Glasgow Haskell Compiler / GHC
Commits:
64013156 by Alan Zimmerman at 2024-04-21T12:43:22+01:00
EPA: Fix span for PatBuilderAppType
Include the location of the prefix @ in the span for InVisPat.
Also removes unnecessary annotations from HsTP.
Contributes to #24669
(cherry picked from commit 26036f96919b1a8b99715dd99724163012c719fc)
- - - - -
8 changed files:
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/rename/should_fail/T17594b.stderr
- testsuite/tests/typecheck/should_fail/T17594c.stderr
- testsuite/tests/typecheck/should_fail/T17594d.stderr
- testsuite/tests/typecheck/should_fail/T17594g.stderr
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -219,7 +219,7 @@ type instance XHsPS GhcPs = EpAnnCO
type instance XHsPS GhcRn = HsPSRn
type instance XHsPS GhcTc = HsPSRn
-type instance XHsTP GhcPs = EpAnnCO
+type instance XHsTP GhcPs = NoExtField
type instance XHsTP GhcRn = HsTyPatRn
type instance XHsTP GhcTc = DataConCantHappen
@@ -295,9 +295,9 @@ mkHsPatSigType :: EpAnnCO -> LHsType GhcPs -> HsPatSigType GhcPs
mkHsPatSigType ann x = HsPS { hsps_ext = ann
, hsps_body = x }
-mkHsTyPat :: EpAnnCO -> LHsType GhcPs -> HsTyPat GhcPs
-mkHsTyPat ann x = HsTP { hstp_ext = ann
- , hstp_body = x }
+mkHsTyPat :: LHsType GhcPs -> HsTyPat GhcPs
+mkHsTyPat x = HsTP { hstp_ext = noExtField
+ , hstp_body = x }
mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
mkEmptyWildCardBndrs x = HsWC { hswc_body = x
@@ -589,7 +589,7 @@ mkHsAppTys = foldl' mkHsAppTy
mkHsAppKindTy :: XAppKindTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-mkHsAppKindTy x ty k = addCLocA ty k (HsAppKindTy x ty k)
+mkHsAppKindTy at ty k = addCLocA ty k (HsAppKindTy at ty k)
{-
************************************************************************
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3401,7 +3401,7 @@ bindpat : exp {% -- See Note [Parser-Validator Details] in GHC.Parse
argpat :: { LPat GhcPs }
argpat : apat { $1 }
- | PREFIX_AT atype { L (getLocAnn (reLoc $2)) (InvisPat (epTok $1) (mkHsTyPat noAnn $2)) }
+ | PREFIX_AT atype { sLLa $1 $> (InvisPat (epTok $1) (mkHsTyPat $2)) }
argpats :: { [LPat GhcPs] }
: argpat argpats { $1 : $2 }
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1458,9 +1458,12 @@ isFunLhs e = go e [] [] []
op_app = mk $ L loc (PatBuilderOpApp (L k_loc k)
(L loc' op) r (reverse ops ++ cps))
reassociate _other = Nothing
- go (L _ (PatBuilderAppType pat tok ty_pat@(HsTP _ (L loc _)))) es ops cps
- = go pat (L loc (ArgPatBuilderArgPat invis_pat) : es) ops cps
+ go (L _ (PatBuilderAppType pat tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps
+ = go pat (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps
where invis_pat = InvisPat tok ty_pat
+ anc' = case tok of
+ NoEpTok -> anc
+ EpTok l -> widenAnchor anc [AddEpAnn AnnAnyclass l]
go _ _ _ _ = return Nothing
data ArgPatBuilder p
@@ -1920,8 +1923,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2)
mkHsAppTypePV l p at t = do
!cs <- getCommentsFor (locA l)
- let anns = EpAnn (spanAsAnchor (getLocA t)) NoEpAnns cs
- return $ L l (PatBuilderAppType p at (mkHsTyPat anns t))
+ return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t))
mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat
mkHsDoPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
mkHsParPV l lpar p rpar = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)
@@ -1978,7 +1980,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkSumOrTuplePV = mkSumOrTuplePat
mkHsEmbTyPV l toktype ty =
return $ L (noAnnSrcSpan l) $
- PatBuilderPat (EmbTyPat toktype (mkHsTyPat noAnn ty))
+ PatBuilderPat (EmbTyPat toktype (mkHsTyPat ty))
rejectPragmaPV _ = return ()
-- | Ensure that a literal pattern isn't of type Addr#, Float#, Double#.
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1446,7 +1446,7 @@ cvtp (ConP s ts ps) = do { s' <- cNameN s
; ps' <- cvtPats ps
; ts' <- mapM cvtType ts
; let pps = map (parenthesizePat appPrec) ps'
- pts = map (\t -> HsConPatTyArg noAnn (mkHsTyPat noAnn t)) ts'
+ pts = map (\t -> HsConPatTyArg noAnn (mkHsTyPat t)) ts'
; return $ ConPat
{ pat_con_ext = noAnn
, pat_con = s'
@@ -1489,9 +1489,9 @@ cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noAnn e' p'}
cvtp (TypeP t) = do { t' <- cvtType t
- ; return $ EmbTyPat noAnn (mkHsTyPat noAnn t') }
+ ; return $ EmbTyPat noAnn (mkHsTyPat t') }
cvtp (InvisP t) = do { t' <- cvtType t
- ; pure (InvisPat noAnn (mkHsTyPat noAnn t'))}
+ ; pure (InvisPat noAnn (mkHsTyPat t'))}
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (s,p)
=====================================
testsuite/tests/rename/should_fail/T17594b.stderr
=====================================
@@ -1,84 +1,84 @@
-T17594b.hs:7:6: error: [GHC-78249]
+T17594b.hs:7:5: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:10:6: error: [GHC-78249]
+T17594b.hs:10:5: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:14:6: error: [GHC-78249]
+T17594b.hs:14:5: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:6: error: [GHC-78249]
+T17594b.hs:17:5: error: [GHC-78249]
Illegal invisible type pattern: t1
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:10: error: [GHC-78249]
+T17594b.hs:17:9: error: [GHC-78249]
Illegal invisible type pattern: t2
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:14: error: [GHC-78249]
+T17594b.hs:17:13: error: [GHC-78249]
Illegal invisible type pattern: t3
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:27: error: [GHC-78249]
+T17594b.hs:17:26: error: [GHC-78249]
Illegal invisible type pattern: t4
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:31: error: [GHC-78249]
+T17594b.hs:17:30: error: [GHC-78249]
Illegal invisible type pattern: t5
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:17:35: error: [GHC-78249]
+T17594b.hs:17:34: error: [GHC-78249]
Illegal invisible type pattern: t6
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:20:11: error: [GHC-78249]
+T17594b.hs:20:10: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:22:20: error: [GHC-78249]
+T17594b.hs:22:19: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:25:10: error: [GHC-78249]
+T17594b.hs:25:9: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:6: error: [GHC-78249]
+T17594b.hs:28:5: error: [GHC-78249]
Illegal invisible type pattern: t1
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:10: error: [GHC-78249]
+T17594b.hs:28:9: error: [GHC-78249]
Illegal invisible type pattern: t2
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:32: error: [GHC-78249]
+T17594b.hs:28:31: error: [GHC-78249]
Illegal invisible type pattern: t3
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:58: error: [GHC-78249]
+T17594b.hs:28:57: error: [GHC-78249]
Illegal invisible type pattern: t4
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:62: error: [GHC-78249]
+T17594b.hs:28:61: error: [GHC-78249]
Illegal invisible type pattern: t5
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:28:71: error: [GHC-78249]
+T17594b.hs:28:70: error: [GHC-78249]
Illegal invisible type pattern: t6
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:31:11: error: [GHC-78249]
+T17594b.hs:31:10: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:34:11: error: [GHC-78249]
+T17594b.hs:34:10: error: [GHC-78249]
Illegal invisible type pattern: t
Suggested fix: Perhaps you intended to use TypeAbstractions
-T17594b.hs:37:7: error: [GHC-78249]
+T17594b.hs:37:6: error: [GHC-78249]
Illegal invisible type pattern: ($(TH.varT (TH.mkName "t")))
Suggested fix: Perhaps you intended to use TypeAbstractions
=====================================
testsuite/tests/typecheck/should_fail/T17594c.stderr
=====================================
@@ -1,5 +1,5 @@
-T17594c.hs:5:11: error: [GHC-14964]
+T17594c.hs:5:10: error: [GHC-14964]
• Invisible type pattern t has no associated forall
• In the expression: \ @t -> undefined :: t
In the expression: [\ @t -> undefined :: t]
=====================================
testsuite/tests/typecheck/should_fail/T17594d.stderr
=====================================
@@ -1,4 +1,4 @@
-T17594d.hs:8:6: error: [GHC-14964]
+T17594d.hs:8:5: error: [GHC-14964]
• Invisible type pattern t has no associated forall
• In an equation for ‘id'’: id' @t x = x :: t
=====================================
testsuite/tests/typecheck/should_fail/T17594g.stderr
=====================================
@@ -1,4 +1,4 @@
-T17594g.hs:6:6: error: [GHC-14964]
+T17594g.hs:6:5: error: [GHC-14964]
• Invisible type pattern a has no associated forall
• In an equation for ‘id'’: id' @a x = x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/640131560e6e305106f9ef22d8831f0597d2aac4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/640131560e6e305106f9ef22d8831f0597d2aac4
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/5ce33989/attachment-0001.html>
More information about the ghc-commits
mailing list