[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: Remove EpAnn from most HsType extension points
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Dec 10 14:00:11 UTC 2023
Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
86960e06 by Alan Zimmerman at 2023-12-10T13:59:16+00:00
EPA: Remove EpAnn from most HsType extension points
Just a few tricky ones left, coming next
- - - - -
12 changed files:
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.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/T20452.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -352,12 +352,12 @@ type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpAnn [AddEpAnn]
type instance XAppTy (GhcPass _) = NoExtField
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 XListTy (GhcPass _) = AnnParen
+type instance XTupleTy (GhcPass _) = AnnParen
+type instance XSumTy (GhcPass _) = AnnParen
+type instance XOpTy (GhcPass _) = [AddEpAnn]
type instance XParTy (GhcPass _) = AnnParen
-type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn]
+type instance XIParamTy (GhcPass _) = [AddEpAnn]
type instance XStarTy (GhcPass _) = NoExtField
type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn]
@@ -372,7 +372,7 @@ type instance XSpliceTy GhcTc = Kind
type instance XDocTy (GhcPass _) = [AddEpAnn]
type instance XBangTy (GhcPass _) = [AddEpAnn]
-type instance XRecTy GhcPs = EpAnn AnnList
+type instance XRecTy GhcPs = AnnList
type instance XRecTy GhcRn = NoExtField
type instance XRecTy GhcTc = NoExtField
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2174,7 +2174,7 @@ ctype :: { LHsType GhcPs }
, hst_xqual = NoExtField
, hst_body = $3 })) }
- | ipvar '::' ctype {% acsA (\cs -> sLL $1 $> (HsIParamTy (EpAnn (glEE $1 $>) [mu AnnDcolon $2] cs) (reLoc $1) $3)) }
+ | ipvar '::' ctype {% amsA' (sLL $1 $> (HsIParamTy [mu AnnDcolon $2] (reLoc $1) $3)) }
| type { $1 }
----------------------
@@ -2267,18 +2267,18 @@ atype :: { LHsType GhcPs }
| PREFIX_TILDE atype {% amsA' (sLL $1 $> (mkBangTy [mj AnnTilde $1] SrcLazy $2)) }
| PREFIX_BANG atype {% amsA' (sLL $1 $> (mkBangTy [mj AnnBang $1] SrcStrict $2)) }
- | '{' fielddecls '}' {% do { decls <- acsA (\cs -> (sLL $1 $> $ HsRecTy (EpAnn (glEE $1 $>) (AnnList (listAsAnchorM $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) $2))
+ | '{' fielddecls '}' {% do { decls <- amsA' (sLL $1 $> $ HsRecTy (AnnList (listAsAnchorM $2) (Just $ moc $1) (Just $ mcc $3) [] []) $2)
; checkRecordSyntax decls }}
-- Constructor sigs only
- | '(' ')' {% acsA (\cs -> sLL $1 $> $ HsTupleTy (EpAnn (glEE $1 $>) (AnnParen AnnParens (glAA $1) (glAA $2)) cs)
+ | '(' ')' {% amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParens (glAA $1) (glAA $2))
HsBoxedOrConstraintTuple []) }
| '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $2 (gl $3)
- ; acsA (\cs -> sLL $1 $> $ HsTupleTy (EpAnn (glEE $1 $>) (AnnParen AnnParens (glAA $1) (glAA $5)) cs)
+ ; amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParens (glAA $1) (glAA $5))
HsBoxedOrConstraintTuple (h : $4)) }}
- | '(#' '#)' {% acsA (\cs -> sLL $1 $> $ HsTupleTy (EpAnn (glEE $1 $>) (AnnParen AnnParensHash (glAA $1) (glAA $2)) cs) HsUnboxedTuple []) }
- | '(#' 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) }
+ | '(#' '#)' {% amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParensHash (glAA $1) (glAA $2)) HsUnboxedTuple []) }
+ | '(#' comma_types1 '#)' {% amsA' (sLL $1 $> $ HsTupleTy (AnnParen AnnParensHash (glAA $1) (glAA $3)) HsUnboxedTuple $2) }
+ | '(#' bar_types2 '#)' {% amsA' (sLL $1 $> $ HsSumTy (AnnParen AnnParensHash (glAA $1) (glAA $3)) $2) }
+ | '[' ktype ']' {% amsA' (sLL $1 $> $ HsListTy (AnnParen AnnParensSquare (glAA $1) (glAA $3)) $2) }
| '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (AnnParen AnnParens (glAA $1) (glAA $3)) $2) }
| quasiquote { mapLocA (HsSpliceTy noExtField) $1 }
| splice_untyped { mapLocA (HsSpliceTy noExtField) $1 }
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -815,14 +815,14 @@ mkGadtDecl loc names dcol ty = do
(args, res_ty, annsa, csa) <-
case body_ty of
- L ll (HsFunTy _ hsArr (L _loc' (HsRecTy an rf)) res_ty) -> do
+ L ll (HsFunTy _ hsArr (L (EpAnn anc _ cs) (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 (EpAnn anc an cs) rf), res_ty
, [], epAnnComments ll)
_ -> do
let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
@@ -1160,12 +1160,9 @@ checkContext orig_t@(L (EpAnn l _ _) _orig_t) =
-- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
-- be used as context constraints.
-- Ditto ()
- = do
- let (op,cp,cs') = case ann' of
- EpAnn _ (AnnParen _ o c) cs -> ([o],[c],cs)
- return (L (EpAnn l
- -- Append parens so that the original order in the source is maintained
- (AnnContext Nothing (oparens ++ op) (cp ++ cparens)) (cs Semi.<> cs')) ts)
+ = return (L (EpAnn l
+ -- Append parens so that the original order in the source is maintained
+ (AnnContext Nothing (oparens ++ [ap_open ann']) (ap_close ann':cparens)) cs) ts)
check (opi,cpi,csi) (L _lp1 (HsParTy ann' ty))
-- to be sure HsParTy doesn't get into the way
@@ -2034,8 +2031,8 @@ dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
-- Detect when the record syntax is used:
-- data T = MkT { ... }
dataConBuilderDetails (PrefixDataConBuilder flds _)
- | [L _ (HsRecTy an fields)] <- toList flds
- = RecCon (L an fields)
+ | [L (EpAnn anc _ cs) (HsRecTy an fields)] <- toList flds
+ = RecCon (L (EpAnn anc an cs) fields)
-- Normal prefix constructor, e.g. data T = MkT A B C
dataConBuilderDetails (PrefixDataConBuilder flds _)
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -375,14 +375,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { Test20239.hs:7:83-84 })
- (AnnParen
- (AnnParens)
- (EpaSpan { Test20239.hs:7:83 })
- (EpaSpan { Test20239.hs:7:84 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { Test20239.hs:7:83 })
+ (EpaSpan { Test20239.hs:7:84 }))
(HsBoxedOrConstraintTuple)
[])))))))))))))])
(Nothing)))])
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -247,14 +247,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { T17544_kw.hs:19:18-19 })
- (AnnParen
- (AnnParens)
- (EpaSpan { T17544_kw.hs:19:18 })
- (EpaSpan { T17544_kw.hs:19:19 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { T17544_kw.hs:19:18 })
+ (EpaSpan { T17544_kw.hs:19:19 }))
(HsBoxedOrConstraintTuple)
[])))])
(L
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -248,14 +248,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:9:16-18 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpParsedAst.hs:9:16 })
- (EpaSpan { DumpParsedAst.hs:9:18 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpParsedAst.hs:9:16 })
+ (EpaSpan { DumpParsedAst.hs:9:18 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:9:17 })
@@ -370,11 +366,7 @@
(EpaComments
[]))
(HsOpTy
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(NotPromoted)
(L
(EpAnn
@@ -640,14 +632,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:10:27-29 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpParsedAst.hs:10:27 })
- (EpaSpan { DumpParsedAst.hs:10:29 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpParsedAst.hs:10:27 })
+ (EpaSpan { DumpParsedAst.hs:10:29 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:10:28 })
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -309,11 +309,7 @@
(EpaComments
[]))
(HsOpTy
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(NotPromoted)
(L
(EpAnn
@@ -567,14 +563,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:12:27-29 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpRenamedAst.hs:12:27 })
- (EpaSpan { DumpRenamedAst.hs:12:29 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpRenamedAst.hs:12:27 })
+ (EpaSpan { DumpRenamedAst.hs:12:29 }))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:12:28 })
@@ -677,14 +669,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:11:16-18 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpRenamedAst.hs:11:16 })
- (EpaSpan { DumpRenamedAst.hs:11:18 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpRenamedAst.hs:11:16 })
+ (EpaSpan { DumpRenamedAst.hs:11:18 }))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:11:17 })
@@ -2358,14 +2346,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:31:12-14 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpRenamedAst.hs:31:12 })
- (EpaSpan { DumpRenamedAst.hs:31:14 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpRenamedAst.hs:31:12 })
+ (EpaSpan { DumpRenamedAst.hs:31:14 }))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:31:13 })
@@ -2430,14 +2414,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:32:10-12 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { DumpRenamedAst.hs:32:10 })
- (EpaSpan { DumpRenamedAst.hs:32:12 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { DumpRenamedAst.hs:32:10 })
+ (EpaSpan { DumpRenamedAst.hs:32:12 }))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:32:11 })
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -220,14 +220,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { DumpSemis.hs:9:11-12 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpSemis.hs:9:11 })
- (EpaSpan { DumpSemis.hs:9:12 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpSemis.hs:9:11 })
+ (EpaSpan { DumpSemis.hs:9:12 }))
(HsBoxedOrConstraintTuple)
[]))))))))))
,(L
@@ -525,14 +521,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { DumpSemis.hs:14:11-12 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpSemis.hs:14:11 })
- (EpaSpan { DumpSemis.hs:14:12 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpSemis.hs:14:11 })
+ (EpaSpan { DumpSemis.hs:14:12 }))
(HsBoxedOrConstraintTuple)
[]))))))))))
,(L
@@ -793,14 +785,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { DumpSemis.hs:21:11-12 })
- (AnnParen
- (AnnParens)
- (EpaSpan { DumpSemis.hs:21:11 })
- (EpaSpan { DumpSemis.hs:21:12 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { DumpSemis.hs:21:11 })
+ (EpaSpan { DumpSemis.hs:21:12 }))
(HsBoxedOrConstraintTuple)
[]))))))))))
,(L
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -304,14 +304,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { KindSigs.hs:15:14-51 })
- (AnnParen
- (AnnParens)
- (EpaSpan { KindSigs.hs:15:14 })
- (EpaSpan { KindSigs.hs:15:51 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { KindSigs.hs:15:14 })
+ (EpaSpan { KindSigs.hs:15:51 }))
(HsBoxedOrConstraintTuple)
[(L
(EpAnn
@@ -548,14 +544,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { KindSigs.hs:16:15-54 })
- (AnnParen
- (AnnParensHash)
- (EpaSpan { KindSigs.hs:16:15-16 })
- (EpaSpan { KindSigs.hs:16:53-54 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensHash)
+ (EpaSpan { KindSigs.hs:16:15-16 })
+ (EpaSpan { KindSigs.hs:16:53-54 }))
(HsUnboxedTuple)
[(L
(EpAnn
@@ -769,14 +761,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { KindSigs.hs:19:12-26 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { KindSigs.hs:19:12 })
- (EpaSpan { KindSigs.hs:19:26 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { KindSigs.hs:19:12 })
+ (EpaSpan { KindSigs.hs:19:26 }))
(L
(EpAnn
(EpaSpan { KindSigs.hs:19:14-24 })
@@ -1028,14 +1016,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { KindSigs.hs:22:34-35 })
- (AnnParen
- (AnnParens)
- (EpaSpan { KindSigs.hs:22:34 })
- (EpaSpan { KindSigs.hs:22:35 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { KindSigs.hs:22:34 })
+ (EpaSpan { KindSigs.hs:22:35 }))
(HsBoxedOrConstraintTuple)
[]))
(L
@@ -1580,14 +1564,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { KindSigs.hs:28:34-39 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { KindSigs.hs:28:34 })
- (EpaSpan { KindSigs.hs:28:39 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { KindSigs.hs:28:34 })
+ (EpaSpan { KindSigs.hs:28:39 }))
(L
(EpAnn
(EpaSpan { KindSigs.hs:28:35-38 })
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -432,14 +432,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { T20452.hs:8:57-74 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { T20452.hs:8:57 })
- (EpaSpan { T20452.hs:8:74 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { T20452.hs:8:57 })
+ (EpaSpan { T20452.hs:8:74 }))
(L
(EpAnn
(EpaSpan { T20452.hs:8:58-73 })
@@ -448,14 +444,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { T20452.hs:8:58-73 })
- (AnnParen
- (AnnParens)
- (EpaSpan { T20452.hs:8:58 })
- (EpaSpan { T20452.hs:8:73 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { T20452.hs:8:58 })
+ (EpaSpan { T20452.hs:8:73 }))
(HsBoxedOrConstraintTuple)
[(L
(EpAnn
@@ -687,14 +679,10 @@
(EpaComments
[]))
(HsListTy
- (EpAnn
- (EpaSpan { T20452.hs:9:57-74 })
- (AnnParen
- (AnnParensSquare)
- (EpaSpan { T20452.hs:9:57 })
- (EpaSpan { T20452.hs:9:74 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParensSquare)
+ (EpaSpan { T20452.hs:9:57 })
+ (EpaSpan { T20452.hs:9:74 }))
(L
(EpAnn
(EpaSpan { T20452.hs:9:58-73 })
@@ -703,14 +691,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { T20452.hs:9:58-73 })
- (AnnParen
- (AnnParens)
- (EpaSpan { T20452.hs:9:58 })
- (EpaSpan { T20452.hs:9:73 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { T20452.hs:9:58 })
+ (EpaSpan { T20452.hs:9:73 }))
(HsBoxedOrConstraintTuple)
[(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T23315/T23315.stderr
=====================================
@@ -98,14 +98,10 @@
(EpaComments
[]))
(HsTupleTy
- (EpAnn
- (EpaSpan { T23315.hsig:3:6-7 })
- (AnnParen
- (AnnParens)
- (EpaSpan { T23315.hsig:3:6 })
- (EpaSpan { T23315.hsig:3:7 }))
- (EpaComments
- []))
+ (AnnParen
+ (AnnParens)
+ (EpaSpan { T23315.hsig:3:6 })
+ (EpaSpan { T23315.hsig:3:7 }))
(HsBoxedOrConstraintTuple)
[]))))))))
,(L
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -912,26 +912,12 @@ data AnnParen
ap_close :: EpaLocation
} deriving (Data)
-}
-markOpeningParen, markClosingParen :: (Monad m, Monoid w) => EpAnn AnnParen -> EP w m (EpAnn AnnParen)
+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) => EpAnn AnnParen -> (forall a. Lens (a,a) a) -> EP w m (EpAnn AnnParen)
-markParen (EpAnn anc (AnnParen pt o c) cs) l = do
- loc' <- markKwA (view l $ kw pt) (view l (o, c))
- let (o',c') = set l loc' (o,c)
- return (EpAnn anc (AnnParen pt o' c') cs)
- where
- kw AnnParens = (AnnOpenP, AnnCloseP)
- 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
+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')
@@ -4044,18 +4030,18 @@ instance ExactPrint (HsType GhcPs) where
getAnnotationEntry (HsAppTy _ _ _) = NoEntryVal
getAnnotationEntry (HsAppKindTy _ _ _) = NoEntryVal
getAnnotationEntry (HsFunTy _ _ _ _) = NoEntryVal
- getAnnotationEntry (HsListTy an _) = fromAnn an
- getAnnotationEntry (HsTupleTy an _ _) = fromAnn an
- getAnnotationEntry (HsSumTy an _) = fromAnn an
- getAnnotationEntry (HsOpTy an _ _ _ _) = fromAnn an
+ getAnnotationEntry (HsListTy _ _) = NoEntryVal
+ getAnnotationEntry (HsTupleTy _ _ _) = NoEntryVal
+ getAnnotationEntry (HsSumTy _ _) = NoEntryVal
+ getAnnotationEntry (HsOpTy _ _ _ _ _) = NoEntryVal
getAnnotationEntry (HsParTy _ _) = NoEntryVal
- getAnnotationEntry (HsIParamTy an _ _) = fromAnn an
+ getAnnotationEntry (HsIParamTy _ _ _) = NoEntryVal
getAnnotationEntry (HsStarTy _ _) = NoEntryVal
getAnnotationEntry (HsKindSig an _ _) = fromAnn an
getAnnotationEntry (HsSpliceTy _ _) = NoEntryVal
getAnnotationEntry (HsDocTy _ _ _) = NoEntryVal
getAnnotationEntry (HsBangTy _ _ _) = NoEntryVal
- getAnnotationEntry (HsRecTy an _) = fromAnn an
+ getAnnotationEntry (HsRecTy _ _) = NoEntryVal
getAnnotationEntry (HsExplicitListTy _ _ _) = NoEntryVal
getAnnotationEntry (HsExplicitTupleTy _ _) = NoEntryVal
getAnnotationEntry (HsTyLit _ _) = NoEntryVal
@@ -4068,18 +4054,18 @@ instance ExactPrint (HsType GhcPs) where
setAnnotationAnchor a@(HsAppTy _ _ _) _ _ _s = a
setAnnotationAnchor a@(HsAppKindTy _ _ _) _ _ _s = a
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 a@(HsListTy{}) _ _ _s = a
+ setAnnotationAnchor a@(HsTupleTy{}) _ _ _s = a
+ setAnnotationAnchor a@(HsSumTy{}) _ _ _s = a
+ setAnnotationAnchor a@(HsOpTy{}) _ _ _s = a
setAnnotationAnchor a@(HsParTy{}) _ _ _s = a
- setAnnotationAnchor (HsIParamTy an a b) anc ts cs = (HsIParamTy (setAnchorEpa an anc ts cs) a b)
+ setAnnotationAnchor a@(HsIParamTy{}) _ _ _s = a
setAnnotationAnchor a@(HsStarTy _ _) _ _ _s = a
setAnnotationAnchor (HsKindSig an a b) anc ts cs = (HsKindSig (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor a@(HsSpliceTy _ _) _ _ _s = a
setAnnotationAnchor a@(HsDocTy{}) _ _ _s = a
setAnnotationAnchor a@(HsBangTy{}) _ _ _s = a
- setAnnotationAnchor (HsRecTy an a) anc ts cs = (HsRecTy (setAnchorEpa an anc ts cs) a)
+ setAnnotationAnchor a@(HsRecTy{}) _ _ _s = a
setAnnotationAnchor a@(HsExplicitListTy{}) _ _ _s = a
setAnnotationAnchor a@(HsExplicitTupleTy{}) _ _ _s = a
setAnnotationAnchor a@(HsTyLit _ _) _ _ _s = a
@@ -4134,20 +4120,20 @@ instance ExactPrint (HsType GhcPs) where
return (HsSumTy an1 tys')
exact (HsOpTy an promoted t1 lo t2) = do
an0 <- if (isPromoted promoted)
- then markEpAnnL an lidl AnnSimpleQuote
+ then markEpAnnL' an lidl AnnSimpleQuote
else return an
t1' <- markAnnotated t1
lo' <- markAnnotated lo
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
- an0 <- markEpAnnL an lidl AnnDcolon
+ an0 <- markEpAnnL' an lidl AnnDcolon
t' <- markAnnotated t
return (HsIParamTy an0 n' t')
exact (HsStarTy an isUnicode) = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86960e06a48eaf6ac011cf40c4623e2e65aeaef0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86960e06a48eaf6ac011cf40c4623e2e65aeaef0
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/20231210/bf2d9282/attachment-0001.html>
More information about the ghc-commits
mailing list