[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: remove EpAnn from HsParTy and HsFunTy
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sat Dec 9 18:27:55 UTC 2023
Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
5b6a53f9 by Alan Zimmerman at 2023-12-09T18:11:02+00:00
EPA: remove EpAnn from HsParTy and HsFunTy
- - - - -
16 changed files:
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- utils/check-exact/ExactPrint.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -351,12 +351,12 @@ type instance XForAllTy (GhcPass _) = NoExtField
type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpAnn [AddEpAnn]
type instance XAppTy (GhcPass _) = NoExtField
-type instance XFunTy (GhcPass _) = EpAnnCO
+type instance XFunTy (GhcPass _) = NoExtField
type instance XListTy (GhcPass _) = EpAnn AnnParen
type instance XTupleTy (GhcPass _) = EpAnn AnnParen
type instance XSumTy (GhcPass _) = EpAnn AnnParen
type instance XOpTy (GhcPass _) = EpAnn [AddEpAnn]
-type instance XParTy (GhcPass _) = EpAnn AnnParen
+type instance XParTy (GhcPass _) = AnnParen
type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn]
type instance XStarTy (GhcPass _) = NoExtField
type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn]
@@ -615,15 +615,12 @@ splitHsFunType ty = go ty
= let
(anns, cs, args, res) = splitHsFunType ty
anns' = anns ++ annParen2AddEpAnn an
- cs' = cs S.<> epAnnComments l S.<> epAnnComments an
+ cs' = cs S.<> epAnnComments l
in (anns', cs', args, res)
- go (L ll (HsFunTy (EpAnn _ _ cs) mult x y))
+ go (L ll (HsFunTy _ mult x y))
| (anns, csy, args, res) <- splitHsFunType y
- = (anns, csy S.<> epAnnComments ll, HsScaled mult x':args, res)
- where
- L l t = x
- x' = L (addCommentsToEpAnn l cs) t
+ = (anns, csy S.<> epAnnComments ll, HsScaled mult x:args, res)
go other = ([], emptyComments, [], other)
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -631,7 +631,7 @@ nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy f t = noLocA (HsAppTy noExtField f t)
nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA x))
-nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow x) a b)
+nlHsFunTy a b = noLocA (HsFunTy noExtField (HsUnrestrictedArrow x) a b)
where
x = case ghcPass @p of
GhcPs -> noAnn
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2206,17 +2206,15 @@ is connected to the first type too.
type :: { LHsType GhcPs }
-- See Note [%shift: type -> btype]
: btype %shift { $1 }
- | btype '->' ctype {% acsA (\cs -> sLL $1 $>
- $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsUnrestrictedArrow (epUniTok $2)) $1 $3) }
+ | btype '->' ctype {% amsA' (sLL $1 $>
+ $ HsFunTy noExtField (HsUnrestrictedArrow (epUniTok $2)) $1 $3) }
| btype mult '->' ctype {% hintLinear (getLoc $2)
>> let arr = (unLoc $2) (epUniTok $3)
- in acsA (\cs -> sLL $1 $>
- $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) arr $1 $4) }
+ in amsA' (sLL $1 $> $ HsFunTy noExtField arr $1 $4) }
| btype '->.' ctype {% hintLinear (getLoc $2) >>
- acsA (\cs -> sLL $1 $>
- $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsLinearArrow (EpLolly (epTok $2))) $1 $3) }
+ amsA' (sLL $1 $> $ HsFunTy noExtField (HsLinearArrow (EpLolly (epTok $2))) $1 $3) }
-- [mu AnnLollyU $2] }
mult :: { Located (EpUniToken "->" "\8594" -> HsArrow GhcPs) }
@@ -2281,7 +2279,7 @@ atype :: { LHsType GhcPs }
| '(#' comma_types1 '#)' {% acsA (\cs -> sLL $1 $> $ HsTupleTy (EpAnn (glEE $1 $>) (AnnParen AnnParensHash (glAA $1) (glAA $3)) cs) HsUnboxedTuple $2) }
| '(#' bar_types2 '#)' {% acsA (\cs -> sLL $1 $> $ HsSumTy (EpAnn (glEE $1 $>) (AnnParen AnnParensHash (glAA $1) (glAA $3)) cs) $2) }
| '[' ktype ']' {% acsA (\cs -> sLL $1 $> $ HsListTy (EpAnn (glEE $1 $>) (AnnParen AnnParensSquare (glAA $1) (glAA $3)) cs) $2) }
- | '(' ktype ')' {% acsA (\cs -> sLL $1 $> $ HsParTy (EpAnn (glEE $1 $>) (AnnParen AnnParens (glAA $1) (glAA $3)) cs) $2) }
+ | '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (AnnParen AnnParens (glAA $1) (glAA $3)) $2) }
| quasiquote { mapLocA (HsSpliceTy noExtField) $1 }
| splice_untyped { mapLocA (HsSpliceTy noExtField) $1 }
-- see Note [Promotion] for the followings
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -1191,8 +1191,8 @@ widenLocatedAn (EpAnn anc a cs) _as = EpAnn anc a cs
epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns (EpAnn _ anns _) = anns
-annParen2AddEpAnn :: EpAnn AnnParen -> [AddEpAnn]
-annParen2AddEpAnn (EpAnn _ (AnnParen pt o c) _)
+annParen2AddEpAnn :: AnnParen -> [AddEpAnn]
+annParen2AddEpAnn (AnnParen pt o c)
= [AddEpAnn ai o, AddEpAnn ac c]
where
(ai,ac) = parenTypeKws pt
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -815,15 +815,14 @@ mkGadtDecl loc names dcol ty = do
(args, res_ty, annsa, csa) <-
case body_ty of
- L ll (HsFunTy af hsArr (L _loc' (HsRecTy an rf)) res_ty) -> do
- let an' = addCommentsToEpAnn an (comments af)
+ L ll (HsFunTy _ hsArr (L _loc' (HsRecTy an rf)) res_ty) -> do
arr <- case hsArr of
HsUnrestrictedArrow arr -> return arr
_ -> do addError $ mkPlainErrorMsgEnvelope (getLocA body_ty) $
(PsErrIllegalGadtRecordMultiplicity hsArr)
return noAnn
- return ( RecConGADT arr (L an' rf), res_ty
+ return ( RecConGADT arr (L an rf), res_ty
, [], epAnnComments ll)
_ -> do
let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
@@ -953,11 +952,11 @@ checkTyVars pp_what equals_or_where tc tparms
-- Keep around an action for adjusting the annotations of extra parens
chkParens :: [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> HsBndrVis GhcPs -> LHsType GhcPs
-> P (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
- chkParens ops cps cs bvis (L l (HsParTy an ty))
+ chkParens ops cps cs bvis (L l (HsParTy _ ty))
= let
(o,c) = mkParensEpAnn (realSrcSpan $ locA l)
in
- chkParens (o:ops) (c:cps) (cs Semi.<> epAnnComments an) bvis ty
+ chkParens (o:ops) (c:cps) cs bvis ty
chkParens ops cps cs bvis ty = chk ops cps cs bvis ty
-- Check that the name space is correct!
@@ -1072,10 +1071,10 @@ checkTyClHdr is_cls ty
goL (L l ty) acc ops cps fix = go (locA l) ty acc ops cps fix
-- workaround to define '*' despite StarIsType
- go _ (HsParTy an (L l (HsStarTy _ isUni))) acc ops' cps' fix
+ go ll (HsParTy an (L l (HsStarTy _ isUni))) acc ops' cps' fix
= do { addPsMessage (locA l) PsWarnStarBinder
; let name = mkOccNameFS tcClsName (starSym isUni)
- ; let a' = newAnns l an
+ ; let a' = newAnns ll l an
; return (L a' (Unqual name), acc, fix
, (reverse ops') ++ cps') }
@@ -1104,12 +1103,12 @@ checkTyClHdr is_cls ty
-- Combine the annotations from the HsParTy and HsStarTy into a
-- new one for the LocatedN RdrName
- newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN
- newAnns (EpAnn ap (AnnListItem ta) csp) (EpAnn as (AnnParen _ o c) cs) =
+ newAnns :: SrcSpan -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
+ newAnns l (EpAnn ap (AnnListItem ta) csp) (AnnParen _ o c) =
let
- lr = RealSrcSpan (combineRealSrcSpans (anchor ap) (anchor as)) Strict.Nothing
+ lr = combineSrcSpans (RealSrcSpan (anchor ap) Strict.Nothing) l
in
- EpAnn (EpaSpan lr) (NameAnn NameParens o ap c ta) (csp Semi.<> cs)
+ EpAnn (EpaSpan lr) (NameAnn NameParens o ap c ta) csp
-- | Yield a parse error if we have a function applied directly to a do block
-- etc. and BlockArguments is not enabled.
@@ -1170,10 +1169,7 @@ checkContext orig_t@(L (EpAnn l _ _) _orig_t) =
check (opi,cpi,csi) (L _lp1 (HsParTy ann' ty))
-- to be sure HsParTy doesn't get into the way
- = do
- let (op,cp,cs') = case ann' of
- EpAnn _ (AnnParen _ open close ) cs -> ([open],[close],cs)
- check (op++opi,cp++cpi,cs' Semi.<> csi) ty
+ = check (ap_open ann':opi, ap_close ann':cpi, csi) ty
-- No need for anns, returning original
check (_opi,_cpi,_csi) _t =
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -1378,14 +1378,14 @@ tc_fun_type mode mult ty1 ty2 exp_kind = case mode_tyki mode of
; ty1' <- tc_lhs_type mode ty1 arg_k
; ty2' <- tc_lhs_type mode ty2 res_k
; mult' <- tc_mult mode mult
- ; checkExpectedKind (HsFunTy noAnn mult ty1 ty2)
+ ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2)
(tcMkVisFunTy mult' ty1' ty2')
liftedTypeKind exp_kind }
KindLevel -> -- no representation polymorphism in kinds. yet.
do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind
; ty2' <- tc_lhs_type mode ty2 liftedTypeKind
; mult' <- tc_mult mode mult
- ; checkExpectedKind (HsFunTy noAnn mult ty1 ty2)
+ ; checkExpectedKind (HsFunTy noExtField mult ty1 ty2)
(tcMkVisFunTy mult' ty1' ty2')
liftedTypeKind exp_kind }
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1642,7 +1642,7 @@ cvtTypeKind typeOrKind ty
_ -> return $
parenthesizeHsType sigPrec x'
let y'' = parenthesizeHsType sigPrec y'
- returnLA (HsFunTy noAnn (HsUnrestrictedArrow noAnn) x'' y'')
+ returnLA (HsFunTy noExtField (HsUnrestrictedArrow noAnn) x'' y'')
| otherwise
-> do { fun_tc <- returnLA $ getRdrName unrestrictedFunTyCon
; mk_apps (HsTyVar noAnn NotPromoted fun_tc) tys' }
@@ -1657,7 +1657,7 @@ cvtTypeKind typeOrKind ty
parenthesizeHsType sigPrec x'
let y'' = parenthesizeHsType sigPrec y'
w'' = hsTypeToArrow w'
- returnLA (HsFunTy noAnn w'' x'' y'')
+ returnLA (HsFunTy noExtField w'' x'' y'')
| otherwise
-> do { fun_tc <- returnLA $ getRdrName fUNTyCon
; mk_apps (HsTyVar noAnn NotPromoted fun_tc) tys' }
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -219,14 +219,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { Test20239.hs:7:50-86 })
- (AnnParen
- (AnnParens)
- (EpaSpan { Test20239.hs:7:50 })
- (EpaSpan { Test20239.hs:7:86 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { Test20239.hs:7:50 })
+ (EpaSpan { Test20239.hs:7:86 }))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:51-85 })
@@ -235,11 +231,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { Test20239.hs:7:51-85 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { Test20239.hs:7:62-63 })
@@ -307,14 +299,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { Test20239.hs:7:68-85 })
- (AnnParen
- (AnnParens)
- (EpaSpan { Test20239.hs:7:68 })
- (EpaSpan { Test20239.hs:7:85 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { Test20239.hs:7:68 })
+ (EpaSpan { Test20239.hs:7:85 }))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:69-84 })
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -135,11 +135,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { T17544.hs:6:9-16 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { T17544.hs:6:11-12 })
@@ -318,11 +314,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { T17544.hs:10:9-16 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { T17544.hs:10:11-12 })
@@ -499,11 +491,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { T17544.hs:14:9-16 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { T17544.hs:14:11-12 })
@@ -683,11 +671,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { T17544.hs:18:9-16 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { T17544.hs:18:11-12 })
@@ -782,11 +766,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { T17544.hs:20:9-16 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { T17544.hs:20:11-12 })
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -235,11 +235,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:9:16-27 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:9:20-21 })
@@ -362,14 +358,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:11:10-17 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:11:10 })
- (EpaSpan { DumpParsedAst.hs:11:17 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:11:10 })
+ (EpaSpan { DumpParsedAst.hs:11:17 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:11-16 })
@@ -480,14 +472,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:11:26-36 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:11:26 })
- (EpaSpan { DumpParsedAst.hs:11:36 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:11:26 })
+ (EpaSpan { DumpParsedAst.hs:11:36 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:27-35 })
@@ -864,14 +852,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:15:25-29 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:15:25 })
- (EpaSpan { DumpParsedAst.hs:15:29 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:15:25 })
+ (EpaSpan { DumpParsedAst.hs:15:29 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:26-28 })
@@ -973,11 +957,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:17:12-35 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:17:14-15 })
@@ -1013,11 +993,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:17:17-35 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:17:29-30 })
@@ -1030,14 +1006,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:17:17-27 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:17:17 })
- (EpaSpan { DumpParsedAst.hs:17:27 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:17:17 })
+ (EpaSpan { DumpParsedAst.hs:17:27 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:17:18-26 })
@@ -1046,11 +1018,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:17:18-26 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:17:20-21 })
@@ -1462,11 +1430,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:18:31-39 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:18:33-34 })
@@ -1600,11 +1564,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:21:20-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:21:22-23 })
@@ -1640,11 +1600,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:21:25-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:21:27-28 })
@@ -1738,14 +1694,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:22:22-37 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:22:22 })
- (EpaSpan { DumpParsedAst.hs:22:37 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:22:22 })
+ (EpaSpan { DumpParsedAst.hs:22:37 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:23-36 })
@@ -1790,11 +1742,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:22:28-36 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:22:30-31 })
@@ -1859,11 +1807,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:22:42-60 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:22:54-55 })
@@ -1876,14 +1820,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:22:42-52 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:22:42 })
- (EpaSpan { DumpParsedAst.hs:22:52 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:22:42 })
+ (EpaSpan { DumpParsedAst.hs:22:52 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:43-51 })
@@ -1892,11 +1832,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:22:43-51 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:22:45-46 })
@@ -2024,14 +1960,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:23:10-34 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpParsedAst.hs:23:10 })
- (EpaSpan { DumpParsedAst.hs:23:34 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpParsedAst.hs:23:10 })
+ (EpaSpan { DumpParsedAst.hs:23:34 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:11-33 })
@@ -2080,11 +2012,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:23:22-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpParsedAst.hs:23:27-28 })
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -297,14 +297,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:11-16 })
@@ -411,14 +407,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:27-35 })
@@ -674,11 +666,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:11:16-27 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -789,11 +777,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:16:20-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -826,11 +810,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:16:25-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -917,14 +897,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:23-36 })
@@ -968,11 +944,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:19:28-36 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -1033,11 +1005,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:19:42-60 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -1048,14 +1016,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:43-51 })
@@ -1064,11 +1028,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:19:43-51 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -1189,14 +1149,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:11-33 })
@@ -1244,11 +1200,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:20:22-33 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -1583,14 +1535,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:26-28 })
@@ -1971,11 +1919,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:25:31-39 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -2091,11 +2035,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:24:12-35 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -2128,11 +2068,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:24:17-35 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
@@ -2143,14 +2079,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
+ (AnnParen
+ (AnnParens)
(EpaDelta (SameLine 0) [])
- (AnnParen
- (AnnParens)
- (EpaDelta (SameLine 0) [])
- (EpaDelta (SameLine 0) []))
- (EpaComments
- []))
+ (EpaDelta (SameLine 0) []))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:18-26 })
@@ -2159,11 +2091,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:24:18-26 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(NoExtField))
(L
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -1431,11 +1431,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpSemis.hs:29:12-23 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpSemis.hs:29:18-19 })
@@ -1672,11 +1668,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { DumpSemis.hs:31:25-30 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { DumpSemis.hs:31:27-28 })
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -883,11 +883,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { KindSigs.hs:22:8-44 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { KindSigs.hs:22:22-23 })
@@ -900,14 +896,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { KindSigs.hs:22:8-20 })
- (AnnParen
- (AnnParens)
- (EpaSpan { KindSigs.hs:22:8 })
- (EpaSpan { KindSigs.hs:22:20 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { KindSigs.hs:22:8 })
+ (EpaSpan { KindSigs.hs:22:20 }))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:9-19 })
@@ -975,11 +967,7 @@
(EpaComments
[]))
(HsFunTy
- (EpAnn
- (EpaSpan { KindSigs.hs:22:25-44 })
- (NoEpAnns)
- (EpaComments
- []))
+ (NoExtField)
(HsUnrestrictedArrow
(EpUniTok
(EpaSpan { KindSigs.hs:22:30-31 })
@@ -1015,14 +1003,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { KindSigs.hs:22:33-44 })
- (AnnParen
- (AnnParens)
- (EpaSpan { KindSigs.hs:22:33 })
- (EpaSpan { KindSigs.hs:22:44 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { KindSigs.hs:22:33 })
+ (EpaSpan { KindSigs.hs:22:44 }))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:34-43 })
@@ -1785,14 +1769,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { KindSigs.hs:34:9-22 })
- (AnnParen
- (AnnParens)
- (EpaSpan { KindSigs.hs:34:9 })
- (EpaSpan { KindSigs.hs:34:22 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { KindSigs.hs:34:9 })
+ (EpaSpan { KindSigs.hs:34:22 }))
(L
(EpAnn
(EpaSpan { KindSigs.hs:34:10-21 })
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -179,14 +179,10 @@
(EpaComments
[]))
(HsParTy
- (EpAnn
- (EpaSpan { T15323.hs:6:31-36 })
- (AnnParen
- (AnnParens)
- (EpaSpan { T15323.hs:6:31 })
- (EpaSpan { T15323.hs:6:36 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { T15323.hs:6:31 })
+ (EpaSpan { T15323.hs:6:36 }))
(L
(EpAnn
(EpaSpan { T15323.hs:6:32-35 })
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -926,6 +926,20 @@ markParen (EpAnn anc (AnnParen pt o c) cs) l = do
kw AnnParensHash = (AnnOpenPH, AnnClosePH)
kw AnnParensSquare = (AnnOpenS, AnnCloseS)
+markOpeningParen', markClosingParen' :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
+markOpeningParen' an = markParen' an lfst
+markClosingParen' an = markParen' an lsnd
+
+markParen' :: (Monad m, Monoid w) => AnnParen -> (forall a. Lens (a,a) a) -> EP w m AnnParen
+markParen' (AnnParen pt o c) l = do
+ loc' <- markKwA (view l $ kw pt) (view l (o, c))
+ let (o',c') = set l loc' (o,c)
+ return (AnnParen pt o' c')
+ where
+ kw AnnParens = (AnnOpenP, AnnCloseP)
+ kw AnnParensHash = (AnnOpenPH, AnnClosePH)
+ kw AnnParensSquare = (AnnOpenS, AnnCloseS)
+
-- ---------------------------------------------------------------------
-- Bare bones Optics
-- Base on From https://hackage.haskell.org/package/lens-tutorial-1.0.3/docs/Control-Lens-Tutorial.html
@@ -4029,12 +4043,12 @@ instance ExactPrint (HsType GhcPs) where
getAnnotationEntry (HsTyVar an _ _) = fromAnn an
getAnnotationEntry (HsAppTy _ _ _) = NoEntryVal
getAnnotationEntry (HsAppKindTy _ _ _) = NoEntryVal
- getAnnotationEntry (HsFunTy an _ _ _) = fromAnn an
+ getAnnotationEntry (HsFunTy _ _ _ _) = NoEntryVal
getAnnotationEntry (HsListTy an _) = fromAnn an
getAnnotationEntry (HsTupleTy an _ _) = fromAnn an
getAnnotationEntry (HsSumTy an _) = fromAnn an
getAnnotationEntry (HsOpTy an _ _ _ _) = fromAnn an
- getAnnotationEntry (HsParTy an _) = fromAnn an
+ getAnnotationEntry (HsParTy _ _) = NoEntryVal
getAnnotationEntry (HsIParamTy an _ _) = fromAnn an
getAnnotationEntry (HsStarTy _ _) = NoEntryVal
getAnnotationEntry (HsKindSig an _ _) = fromAnn an
@@ -4053,12 +4067,12 @@ instance ExactPrint (HsType GhcPs) where
setAnnotationAnchor (HsTyVar an a b) anc ts cs = (HsTyVar (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor a@(HsAppTy _ _ _) _ _ _s = a
setAnnotationAnchor a@(HsAppKindTy _ _ _) _ _ _s = a
- setAnnotationAnchor (HsFunTy an a b c) anc ts cs = (HsFunTy (setAnchorEpa an anc ts cs) a b c)
+ setAnnotationAnchor a@(HsFunTy{}) _ _ _s = a
setAnnotationAnchor (HsListTy an a) anc ts cs = (HsListTy (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor (HsTupleTy an a b) anc ts cs = (HsTupleTy (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (HsSumTy an a) anc ts cs = (HsSumTy (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor a@(HsOpTy _ _ _ _ _) _ _ _s = a
- setAnnotationAnchor (HsParTy an a) anc ts cs = (HsParTy (setAnchorEpa an anc ts cs) a)
+ setAnnotationAnchor a@(HsParTy{}) _ _ _s = a
setAnnotationAnchor (HsIParamTy an a b) anc ts cs = (HsIParamTy (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor a@(HsStarTy _ _) _ _ _s = a
setAnnotationAnchor (HsKindSig an a b) anc ts cs = (HsKindSig (setAnchorEpa an anc ts cs) a b)
@@ -4127,9 +4141,9 @@ instance ExactPrint (HsType GhcPs) where
t2' <- markAnnotated t2
return (HsOpTy an0 promoted t1' lo' t2')
exact (HsParTy an ty) = do
- an0 <- markOpeningParen an
+ an0 <- markOpeningParen' an
ty' <- markAnnotated ty
- an1 <- markClosingParen an0
+ an1 <- markClosingParen' an0
return (HsParTy an1 ty')
exact (HsIParamTy an n t) = do
n' <- markAnnotated n
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 579df3aa57a9c49b555dbb0feb607b73aa695284
+Subproject commit bbc5ab1bc4c2d064e3dd5f7413f527d57b53a6b1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b6a53f9e5325e5095f1e910bdc2a1f17f99ae96
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b6a53f9e5325e5095f1e910bdc2a1f17f99ae96
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/20231209/0e019682/attachment-0001.html>
More information about the ghc-commits
mailing list