[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: Remove last EpAnn from HsExpr extension points
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sat Dec 9 12:59:35 UTC 2023
Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
5f0e07d8 by Alan Zimmerman at 2023-12-09T12:59:08+00:00
EPA: Remove last EpAnn from HsExpr extension points
- - - - -
6 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/ThToHs.hs
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -184,10 +184,10 @@ data HsBracketTc = HsBracketTc
-- pasted back in by the desugarer
}
-type instance XTypedBracket GhcPs = EpAnn [AddEpAnn]
+type instance XTypedBracket GhcPs = [AddEpAnn]
type instance XTypedBracket GhcRn = NoExtField
type instance XTypedBracket GhcTc = HsBracketTc
-type instance XUntypedBracket GhcPs = EpAnn [AddEpAnn]
+type instance XUntypedBracket GhcPs = [AddEpAnn]
type instance XUntypedBracket GhcRn = [PendingRnSplice] -- See Note [Pending Splices]
-- Output of the renamer is the *original* renamed expression,
-- plus _renamed_ splices to be type checked
@@ -271,7 +271,7 @@ type instance XPar GhcPs = (EpToken "(", EpToken ")")
type instance XPar GhcRn = NoExtField
type instance XPar GhcTc = NoExtField
-type instance XExplicitTuple GhcPs = EpAnn [AddEpAnn]
+type instance XExplicitTuple GhcPs = [AddEpAnn]
type instance XExplicitTuple GhcRn = NoExtField
type instance XExplicitTuple GhcTc = NoExtField
@@ -299,7 +299,7 @@ type instance XDo GhcPs = AnnList
type instance XDo GhcRn = NoExtField
type instance XDo GhcTc = Type
-type instance XExplicitList GhcPs = EpAnn AnnList
+type instance XExplicitList GhcPs = AnnList
type instance XExplicitList GhcRn = NoExtField
type instance XExplicitList GhcTc = Type
-- GhcPs: ExplicitList includes all source-level
@@ -310,11 +310,11 @@ type instance XExplicitList GhcTc = Type
-- See Note [Handling overloaded and rebindable constructs]
-- in GHC.Rename.Expr
-type instance XRecordCon GhcPs = EpAnn [AddEpAnn]
+type instance XRecordCon GhcPs = [AddEpAnn]
type instance XRecordCon GhcRn = NoExtField
type instance XRecordCon GhcTc = PostTcExpr -- Instantiated constructor function
-type instance XRecordUpd GhcPs = EpAnn [AddEpAnn]
+type instance XRecordUpd GhcPs = [AddEpAnn]
type instance XRecordUpd GhcRn = NoExtField
type instance XRecordUpd GhcTc = DataConCantHappen
-- We desugar record updates in the typechecker.
@@ -346,29 +346,29 @@ type instance XLHsRecUpdLabels GhcTc = DataConCantHappen
type instance XLHsOLRecUpdLabels p = NoExtField
-type instance XGetField GhcPs = EpAnnCO
+type instance XGetField GhcPs = NoExtField
type instance XGetField GhcRn = NoExtField
type instance XGetField GhcTc = DataConCantHappen
-- HsGetField is eliminated by the renamer. See [Handling overloaded
-- and rebindable constructs].
-type instance XProjection GhcPs = EpAnn AnnProjection
+type instance XProjection GhcPs = AnnProjection
type instance XProjection GhcRn = NoExtField
type instance XProjection GhcTc = DataConCantHappen
-- HsProjection is eliminated by the renamer. See [Handling overloaded
-- and rebindable constructs].
-type instance XExprWithTySig GhcPs = EpAnn [AddEpAnn]
+type instance XExprWithTySig GhcPs = [AddEpAnn]
type instance XExprWithTySig GhcRn = NoExtField
type instance XExprWithTySig GhcTc = NoExtField
-type instance XArithSeq GhcPs = EpAnn [AddEpAnn]
+type instance XArithSeq GhcPs = [AddEpAnn]
type instance XArithSeq GhcRn = NoExtField
type instance XArithSeq GhcTc = PostTcExpr
-type instance XProc (GhcPass _) = EpAnn [AddEpAnn]
+type instance XProc (GhcPass _) = [AddEpAnn]
-type instance XStatic GhcPs = EpAnn [AddEpAnn]
+type instance XStatic GhcPs = [AddEpAnn]
type instance XStatic GhcRn = NameSet
type instance XStatic GhcTc = (NameSet, Type)
-- Free variables and type of expression, this is stored for convenience as wiring in
@@ -1756,17 +1756,17 @@ data HsUntypedSpliceResult thing -- 'thing' can be HsExpr or HsType
}
| HsUntypedSpliceNested SplicePointName -- A unique name to identify this splice point
-type instance XTypedSplice GhcPs = (EpAnnCO, EpAnn [AddEpAnn])
+type instance XTypedSplice GhcPs = [AddEpAnn]
type instance XTypedSplice GhcRn = SplicePointName
type instance XTypedSplice GhcTc = DelayedSplice
-type instance XUntypedSplice GhcPs = EpAnnCO
+type instance XUntypedSplice GhcPs = NoExtField
type instance XUntypedSplice GhcRn = HsUntypedSpliceResult (HsExpr GhcRn)
type instance XUntypedSplice GhcTc = DataConCantHappen
-- HsUntypedSplice
-type instance XUntypedSpliceExpr GhcPs = EpAnn [AddEpAnn]
-type instance XUntypedSpliceExpr GhcRn = EpAnn [AddEpAnn]
+type instance XUntypedSpliceExpr GhcPs = [AddEpAnn]
+type instance XUntypedSpliceExpr GhcRn = [AddEpAnn]
type instance XUntypedSpliceExpr GhcTc = DataConCantHappen
type instance XQuasiQuote p = NoExtField
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2845,7 +2845,7 @@ fexp :: { ECP }
| 'static' aexp {% runPV (unECP $2) >>= \ $2 ->
fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsStatic (EpAnn (glEE $1 $>) [mj AnnStatic $1] cs) $2) }
+ amsA' (sLL $1 $> $ HsStatic [mj AnnStatic $1] $2) }
| aexp { $1 }
@@ -2929,7 +2929,7 @@ aexp :: { ECP }
{% (checkPattern <=< runPV) (unECP $2) >>= \ p ->
runPV (unECP $4) >>= \ $4 at cmd ->
fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glEE $1 $>) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) }
+ amsA' (sLL $1 $> $ HsProc [mj AnnProc $1,mu AnnRarrow $3] p (sLLa $1 $> $ HsCmdTop noExtField cmd)) }
| aexp1 { $1 }
@@ -2945,9 +2945,9 @@ aexp1 :: { ECP }
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
| aexp1 TIGHT_INFIX_PROJ field
{% runPV (unECP $1) >>= \ $1 ->
- fmap ecpFromExp $ acsA (\cs ->
+ fmap ecpFromExp $ amsA' (
let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in
- sLL $1 $> $ mkRdrGetField $1 fl (EpAnn (glEE $1 $>) NoEpAnns cs)) }
+ sLL $1 $> $ mkRdrGetField $1 fl) }
@@ -2983,7 +2983,7 @@ aexp2 :: { ECP }
-- This case is only possible when 'OverloadedRecordDotBit' is enabled.
| '(' projection ')' { ECP $
- acsA (\cs -> sLL $1 $> $ mkRdrProjection (NE.reverse (unLoc $2)) (EpAnn (glEE $1 $>) (AnnProjection (glAA $1) (glAA $3)) cs))
+ amsA' (sLL $1 $> $ mkRdrProjection (NE.reverse (unLoc $2)) (AnnProjection (glAA $1) (glAA $3)) )
>>= ecpFromExp'
}
@@ -3003,26 +3003,26 @@ aexp2 :: { ECP }
| splice_untyped { ECP $ pvA $ mkHsSplicePV $1 }
| splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLoc $1) }
- | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) }
- | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) }
- | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) }
- | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) }
+ | SIMPLEQUOTE qvar {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnSimpleQuote $1] (VarBr noExtField True $2)) }
+ | SIMPLEQUOTE qcon {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnSimpleQuote $1] (VarBr noExtField True $2)) }
+ | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnThTyQuote $1 ] (VarBr noExtField False $2)) }
+ | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnThTyQuote $1 ] (VarBr noExtField False $2)) }
-- See Note [%shift: aexp2 -> TH_TY_QUOTE]
| TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) }
| '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 ->
fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
- else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) cs) (ExpBr noExtField $2)) }
+ amsA' (sLL $1 $> $ HsUntypedBracket (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
+ else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) (ExpBr noExtField $2)) }
| '[||' exp '||]' {% runPV (unECP $2) >>= \ $2 ->
fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsTypedBracket (EpAnn (glEE $1 $>) (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) cs) $2) }
+ amsA' (sLL $1 $> $ HsTypedBracket (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) $2) }
| '[t|' ktype '|]' {% fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mo $1,mu AnnCloseQ $3] cs) (TypBr noExtField $2)) }
+ amsA' (sLL $1 $> $ HsUntypedBracket [mo $1,mu AnnCloseQ $3] (TypBr noExtField $2)) }
| '[p|' infixexp '|]' {% (checkPattern <=< runPV) (unECP $2) >>= \p ->
fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) [mo $1,mu AnnCloseQ $3] cs) (PatBr noExtField p)) }
+ amsA' (sLL $1 $> $ HsUntypedBracket [mo $1,mu AnnCloseQ $3] (PatBr noExtField p)) }
| '[d|' cvtopbody '|]' {% fmap ecpFromExp $
- acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glEE $1 $>) (mo $1:mu AnnCloseQ $3:fst $2) cs) (DecBrL noExtField (snd $2))) }
+ amsA' (sLL $1 $> $ HsUntypedBracket (mo $1:mu AnnCloseQ $3:fst $2) (DecBrL noExtField (snd $2))) }
| quasiquote { ECP $ pvA $ mkHsSplicePV $1 }
-- arrow notation extension
@@ -3039,19 +3039,19 @@ projection
| PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glEE $1 $>) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) }
splice_exp :: { LHsExpr GhcPs }
- : splice_untyped { fmap (HsUntypedSplice noAnn) (reLoc $1) }
+ : splice_untyped { fmap (HsUntypedSplice noExtField) (reLoc $1) }
| splice_typed { fmap (uncurry HsTypedSplice) (reLoc $1) }
splice_untyped :: { Located (HsUntypedSplice GhcPs) }
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
: PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 ->
- acs (\cs -> sLL $1 $> $ HsUntypedSpliceExpr (EpAnn (glEE $1 $>) [mj AnnDollar $1] cs) $2) }
+ return (sLL $1 $> $ HsUntypedSpliceExpr [mj AnnDollar $1] $2) }
-splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) }
+splice_typed :: { Located ([AddEpAnn], LHsExpr GhcPs) }
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
: PREFIX_DOLLAR_DOLLAR aexp2
{% runPV (unECP $2) >>= \ $2 ->
- acs (\cs -> sLL $1 $> $ ((noAnn, EpAnn (glEE $1 $>) [mj AnnDollarDollar $1] cs), $2)) }
+ return (sLL $1 $> $ ([mj AnnDollarDollar $1], $2)) }
cmdargs :: { [LHsCmdTop GhcPs] }
: cmdargs acmd { $2 : $1 }
@@ -3163,23 +3163,23 @@ list :: { forall b. DisambECP b => SrcSpan -> (AddEpAnn, AddEpAnn) -> PV (Locate
| lexps { \loc (ao,ac) -> $1 >>= \ $1 ->
mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (Just ao) (Just ac) [] []) }
| texp '..' { \loc (ao,ac) -> unECP $1 >>= \ $1 ->
- acsA (\cs -> L loc $ ArithSeq (EpAnn (spanAsAnchor loc) [ao,mj AnnDotdot $2,ac] cs) Nothing (From $1))
+ amsA' (L loc $ ArithSeq [ao,mj AnnDotdot $2,ac] Nothing (From $1))
>>= ecpFromExp' }
| texp ',' exp '..' { \loc (ao,ac) ->
unECP $1 >>= \ $1 ->
unECP $3 >>= \ $3 ->
- acsA (\cs -> L loc $ ArithSeq (EpAnn (spanAsAnchor loc) [ao,mj AnnComma $2,mj AnnDotdot $4,ac] cs) Nothing (FromThen $1 $3))
+ amsA' (L loc $ ArithSeq [ao,mj AnnComma $2,mj AnnDotdot $4,ac] Nothing (FromThen $1 $3))
>>= ecpFromExp' }
| texp '..' exp { \loc (ao,ac) ->
unECP $1 >>= \ $1 ->
unECP $3 >>= \ $3 ->
- acsA (\cs -> L loc $ ArithSeq (EpAnn (spanAsAnchor loc) [ao,mj AnnDotdot $2,ac] cs) Nothing (FromTo $1 $3))
+ amsA' (L loc $ ArithSeq [ao,mj AnnDotdot $2,ac] Nothing (FromTo $1 $3))
>>= ecpFromExp' }
| texp ',' exp '..' exp { \loc (ao,ac) ->
unECP $1 >>= \ $1 ->
unECP $3 >>= \ $3 ->
unECP $5 >>= \ $5 ->
- acsA (\cs -> L loc $ ArithSeq (EpAnn (spanAsAnchor loc) [ao,mj AnnComma $2,mj AnnDotdot $4,ac] cs) Nothing (FromThenTo $1 $3 $5))
+ amsA' (L loc $ ArithSeq [ao,mj AnnComma $2,mj AnnDotdot $4,ac] Nothing (FromThenTo $1 $3 $5))
>>= ecpFromExp' }
| texp '|' flattenedpquals
{ \loc (ao,ac) ->
@@ -4360,7 +4360,7 @@ ams1 (L l a) b = do
cs <- getCommentsFor (locA l)
return (L (EpAnn (spanAsAnchor l) noAnn cs) b)
-amsA' :: MonadP m => Located a -> m (LocatedA a)
+amsA' :: (NoAnn t, MonadP m) => Located a -> m (GenLocated (EpAnn t) a)
amsA' (L l a) = do
cs <- getCommentsFor l
return (L (EpAnn (spanAsAnchor l) noAnn cs) a)
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1835,18 +1835,18 @@ instance DisambECP (HsExpr GhcPs) where
cs <- getCommentsFor (locA l)
return $ L (EpAnn l an (cs Semi.<> csIn)) (HsOverLit NoExtField a)
mkHsWildCardPV l = return $ L l (hsHoleExpr noAnn)
- mkHsTySigPV l a sig anns = do
+ mkHsTySigPV l@(EpAnn anc an csIn) a sig anns = do
cs <- getCommentsFor (locA l)
- return $ L l (ExprWithTySig (EpAnn (spanAsAnchor $ locA l) anns cs) a (hsTypeToHsSigWcType sig))
+ return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExprWithTySig anns a (hsTypeToHsSigWcType sig))
mkHsExplicitListPV l xs anns = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (ExplicitList (EpAnn (spanAsAnchor l) anns cs) xs)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (ExplicitList anns xs)
mkHsSplicePV sp@(L l _) = do
cs <- getCommentsFor l
- return $ fmap (HsUntypedSplice (EpAnn (spanAsAnchor l) NoEpAnns cs)) sp
+ return $ fmap (HsUntypedSplice NoExtField) sp
mkHsRecordPV opts l lrec a (fbinds, ddLoc) anns = do
cs <- getCommentsFor l
- r <- mkRecConstrOrUpdate opts a lrec (fbinds, ddLoc) (EpAnn (spanAsAnchor l) anns cs)
+ r <- mkRecConstrOrUpdate opts a lrec (fbinds, ddLoc) anns
checkRecordSyntax (L (noAnnSrcSpan l) r)
mkHsNegAppPV l a anns = do
cs <- getCommentsFor l
@@ -2565,7 +2565,7 @@ mkRecConstrOrUpdate
-> LHsExpr GhcPs
-> SrcSpan
-> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan)
- -> EpAnn [AddEpAnn]
+ -> [AddEpAnn]
-> PV (HsExpr GhcPs)
mkRecConstrOrUpdate _ (L _ (HsVar _ (L l c))) _lrec (fbinds,dd) anns
| isRdrDataCon c
@@ -2580,7 +2580,7 @@ mkRecConstrOrUpdate overloaded_update exp _ (fs,dd) anns
PsErrDotsInRecordUpdate
| otherwise = mkRdrRecordUpd overloaded_update exp fs anns
-mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs)
+mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> [AddEpAnn] -> PV (HsExpr GhcPs)
mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
-- We do not need to know if OverloadedRecordDot is in effect. We do
-- however need to know if OverloadedRecordUpdate (passed in
@@ -2641,7 +2641,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do
punnedVar f = if not pun then arg else noLocA . HsVar noExtField . noLocA . mkRdrUnqual . mkVarOccFS $ f
mkRdrRecordCon
- :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs
+ :: LocatedN RdrName -> HsRecordBinds GhcPs -> [AddEpAnn] -> HsExpr GhcPs
mkRdrRecordCon con flds anns
= RecordCon { rcon_ext = anns, rcon_con = con, rcon_flds = flds }
@@ -3132,9 +3132,9 @@ mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
-> PV (LHsExpr GhcPs)
-- Tuple
-mkSumOrTupleExpr l boxity (Tuple es) anns = do
+mkSumOrTupleExpr l@(EpAnn anc an csIn) boxity (Tuple es) anns = do
cs <- getCommentsFor (locA l)
- return $ L l (ExplicitTuple (EpAnn (spanAsAnchor $ locA l) anns cs) (map toTupArg es) boxity)
+ return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExplicitTuple anns (map toTupArg es) boxity)
where
toTupArg :: Either (EpAnn Bool) (LHsExpr GhcPs) -> HsTupArg GhcPs
toTupArg (Left ann) = missingTupArg ann
@@ -3220,15 +3220,15 @@ starSym False = fsLit "*"
-- Bits and pieces for RecordDotSyntax.
mkRdrGetField :: LHsExpr GhcPs -> LocatedAn NoEpAnns (DotFieldOcc GhcPs)
- -> EpAnnCO -> HsExpr GhcPs
-mkRdrGetField arg field anns =
+ -> HsExpr GhcPs
+mkRdrGetField arg field =
HsGetField {
- gf_ext = anns
+ gf_ext = NoExtField
, gf_expr = arg
, gf_field = field
}
-mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)) -> EpAnn AnnProjection -> HsExpr GhcPs
+mkRdrProjection :: NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)) -> AnnProjection -> HsExpr GhcPs
mkRdrProjection flds anns =
HsProjection {
proj_ext = anns
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1655,8 +1655,8 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
mk_untyped_bracket = HsUntypedBracket noAnn . ExpBr noExtField
mk_typed_bracket = HsTypedBracket noAnn
- mk_tsplice = HsTypedSplice (noAnn, noAnn)
- mk_usplice = HsUntypedSplice noAnn . HsUntypedSpliceExpr noAnn
+ mk_tsplice = HsTypedSplice []
+ mk_usplice = HsUntypedSplice noExtField . HsUntypedSpliceExpr noAnn
data_cons = getPossibleDataCons tycon tycon_args
pats_etc mk_bracket mk_splice lift_name data_con
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1156,12 +1156,12 @@ cvtl e = wrapLA (cvt e)
cvt (LabelE s) = return $ HsOverLabel noExtField NoSourceText (fsLit s)
cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' }
cvt (GetFieldE exp f) = do { e' <- cvtl exp
- ; return $ HsGetField noComments e'
+ ; return $ HsGetField noExtField e'
(L noSrcSpanA (DotFieldOcc noAnn (L noSrcSpanA (FieldLabelString (fsLit f))))) }
cvt (ProjectionE xs) = return $ HsProjection noAnn $ fmap
(L noSrcSpanA . DotFieldOcc noAnn . L noSrcSpanA . FieldLabelString . fsLit) xs
cvt (TypedSpliceE e) = do { e' <- parenthesizeHsExpr appPrec <$> cvtl e
- ; return $ HsTypedSplice (noAnn, noAnn) e' }
+ ; return $ HsTypedSplice [] e' }
cvt (TypedBracketE e) = do { e' <- cvtl e
; return $ HsTypedBracket noAnn e' }
cvt (TypeE t) = do { t' <- cvtType t
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1305,11 +1305,6 @@ markLensKw' a l kw = do
loc <- markKwA kw (view l a)
return (set l loc a)
--- TODO: delete this in favour of markLensKw
-markAnnKwL :: (Monad m, Monoid w)
- => EpAnn a -> Lens a EpaLocation -> AnnKeywordId -> EP w m (EpAnn a)
-markAnnKwL = markLensKw
-
markAnnKwAllL :: (Monad m, Monoid w)
=> EpAnn a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m (EpAnn a)
markAnnKwAllL (EpAnn anc a cs) l kw = do
@@ -2943,81 +2938,8 @@ instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where
-- ---------------------------------------------------------------------
instance ExactPrint (HsExpr GhcPs) where
- getAnnotationEntry (HsVar{}) = NoEntryVal
- getAnnotationEntry (HsUnboundVar{}) = NoEntryVal
- getAnnotationEntry (HsRecSel{}) = NoEntryVal
- getAnnotationEntry (HsOverLabel{}) = NoEntryVal
- getAnnotationEntry (HsIPVar{}) = NoEntryVal
- getAnnotationEntry (HsOverLit{}) = NoEntryVal
- getAnnotationEntry (HsLit{}) = NoEntryVal
- getAnnotationEntry (HsLam{}) = NoEntryVal
- getAnnotationEntry (HsApp{}) = NoEntryVal
- getAnnotationEntry (HsAppType _ _ _) = NoEntryVal
- getAnnotationEntry (OpApp _ _ _ _) = NoEntryVal
- getAnnotationEntry (NegApp _ _ _) = NoEntryVal
- getAnnotationEntry (HsPar{}) = NoEntryVal
- getAnnotationEntry (SectionL _ _ _) = NoEntryVal
- getAnnotationEntry (SectionR _ _ _) = NoEntryVal
- getAnnotationEntry (ExplicitTuple an _ _) = fromAnn an
- getAnnotationEntry (ExplicitSum _ _ _ _) = NoEntryVal
- getAnnotationEntry (HsCase _ _ _) = NoEntryVal
- getAnnotationEntry (HsIf _ _ _ _) = NoEntryVal
- getAnnotationEntry (HsMultiIf _ _) = NoEntryVal
- getAnnotationEntry (HsLet _ _ _) = NoEntryVal
- getAnnotationEntry (HsDo _ _ _) = NoEntryVal
- getAnnotationEntry (ExplicitList an _) = fromAnn an
- getAnnotationEntry (RecordCon an _ _) = fromAnn an
- getAnnotationEntry (RecordUpd an _ _) = fromAnn an
- getAnnotationEntry (HsGetField an _ _) = fromAnn an
- getAnnotationEntry (HsProjection an _) = fromAnn an
- getAnnotationEntry (ExprWithTySig an _ _) = fromAnn an
- getAnnotationEntry (ArithSeq an _ _) = fromAnn an
- getAnnotationEntry (HsTypedBracket an _) = fromAnn an
- getAnnotationEntry (HsUntypedBracket an _) = fromAnn an
- getAnnotationEntry (HsTypedSplice (_, an) _) = fromAnn an
- getAnnotationEntry (HsUntypedSplice an _) = fromAnn an
- getAnnotationEntry (HsProc an _ _) = fromAnn an
- getAnnotationEntry (HsStatic an _) = fromAnn an
- getAnnotationEntry (HsPragE{}) = NoEntryVal
- getAnnotationEntry (HsEmbTy{}) = NoEntryVal
-
- setAnnotationAnchor a@(HsVar{}) _ _ _s = a
- setAnnotationAnchor a@(HsUnboundVar{}) _ _ _s = a
- setAnnotationAnchor a@(HsRecSel{}) _ _ _s = a
- setAnnotationAnchor a@(HsOverLabel{}) _ _ _s = a
- setAnnotationAnchor a@(HsIPVar{}) _ _ _s = a
- setAnnotationAnchor a@(HsOverLit {}) _ _ _s = a
- setAnnotationAnchor a@(HsLit {}) _ _ _s = a
- setAnnotationAnchor a@(HsLam{}) _ _ _s = a
- setAnnotationAnchor a@(HsApp{}) _ _ _s = a
- setAnnotationAnchor a@(HsAppType {}) _ _ _s = a
- setAnnotationAnchor a@(OpApp{}) _ _ _s = a
- setAnnotationAnchor a@(NegApp{}) _ _ _s = a
- setAnnotationAnchor a@(HsPar {}) _ _ _s = a
- setAnnotationAnchor a@(SectionL{}) _ _ _s = a
- setAnnotationAnchor a@(SectionR{}) _ _ _s = a
- setAnnotationAnchor (ExplicitTuple an a b) anc ts cs = (ExplicitTuple (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(ExplicitSum{}) _ _ _s = a
- setAnnotationAnchor a@(HsCase{}) _ _ _s = a
- setAnnotationAnchor a@(HsIf{}) _ _ _s = a
- setAnnotationAnchor a@(HsMultiIf{}) _ _ _s = a
- setAnnotationAnchor a@(HsLet{}) _ _ _s = a
- setAnnotationAnchor a@(HsDo{}) _ _ _s = a
- setAnnotationAnchor (ExplicitList an a) anc ts cs = (ExplicitList (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (RecordCon an a b) anc ts cs = (RecordCon (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (RecordUpd an a b) anc ts cs = (RecordUpd (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsGetField an a b) anc ts cs = (HsGetField (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsProjection an a) anc ts cs = (HsProjection (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (ExprWithTySig an a b) anc ts cs = (ExprWithTySig (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (ArithSeq an a b) anc ts cs = (ArithSeq (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsTypedBracket an a) anc ts cs = (HsTypedBracket (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (HsUntypedBracket an a) anc ts cs = (HsUntypedBracket (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (HsTypedSplice (x,an) e) anc ts cs = (HsTypedSplice (x,(setAnchorEpa an anc ts cs)) e)
- setAnnotationAnchor (HsUntypedSplice an e) anc ts cs = (HsUntypedSplice (setAnchorEpa an anc ts cs) e)
- setAnnotationAnchor (HsProc an a b) anc ts cs = (HsProc (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsStatic an a) anc ts cs = (HsStatic (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor a@(HsPragE{}) _ _ _s = a
- setAnnotationAnchor a@(HsEmbTy{}) _ _ _s = a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _s = a
exact (HsVar x n) = do
-- The parser inserts a placeholder value for a record pun rhs. This must be
@@ -3111,13 +3033,13 @@ instance ExactPrint (HsExpr GhcPs) where
return (SectionR an op' expr')
exact (ExplicitTuple an args b) = do
- an0 <- if b == Boxed then markEpAnnL an lidl AnnOpenP
- else markEpAnnL an lidl AnnOpenPH
+ an0 <- if b == Boxed then markEpAnnL' an lidl AnnOpenP
+ else markEpAnnL' an lidl AnnOpenPH
args' <- mapM markAnnotated args
- an1 <- if b == Boxed then markEpAnnL an0 lidl AnnCloseP
- else markEpAnnL an0 lidl AnnClosePH
+ an1 <- if b == Boxed then markEpAnnL' an0 lidl AnnCloseP
+ else markEpAnnL' an0 lidl AnnClosePH
debugM $ "ExplicitTuple done"
return (ExplicitTuple an1 args' b)
@@ -3172,132 +3094,133 @@ instance ExactPrint (HsExpr GhcPs) where
exact (ExplicitList an es) = do
debugM $ "ExplicitList start"
- an0 <- markLensMAA an lal_open
+ an0 <- markLensMAA' an lal_open
es' <- markAnnotated es
- an1 <- markLensMAA an0 lal_close
+ an1 <- markLensMAA' an0 lal_close
debugM $ "ExplicitList end"
return (ExplicitList an1 es')
exact (RecordCon an con_id binds) = do
con_id' <- markAnnotated con_id
- an0 <- markEpAnnL an lidl AnnOpenC
+ an0 <- markEpAnnL' an lidl AnnOpenC
binds' <- markAnnotated binds
- an1 <- markEpAnnL an0 lidl AnnCloseC
+ an1 <- markEpAnnL' an0 lidl AnnCloseC
return (RecordCon an1 con_id' binds')
exact (RecordUpd an expr fields) = do
expr' <- markAnnotated expr
- an0 <- markEpAnnL an lidl AnnOpenC
+ an0 <- markEpAnnL' an lidl AnnOpenC
fields' <- markAnnotated fields
- an1 <- markEpAnnL an0 lidl AnnCloseC
+ an1 <- markEpAnnL' an0 lidl AnnCloseC
return (RecordUpd an1 expr' fields')
exact (HsGetField an expr field) = do
expr' <- markAnnotated expr
field' <- markAnnotated field
return (HsGetField an expr' field')
exact (HsProjection an flds) = do
- an0 <- markAnnKwL an lapOpen AnnOpenP
+ an0 <- markLensKw' an lapOpen AnnOpenP
flds' <- mapM markAnnotated flds
- an1 <- markAnnKwL an0 lapClose AnnCloseP
+ an1 <- markLensKw' an0 lapClose AnnCloseP
return (HsProjection an1 flds')
exact (ExprWithTySig an expr sig) = do
expr' <- markAnnotated expr
- an0 <- markEpAnnL an lidl AnnDcolon
+ an0 <- markEpAnnL' an lidl AnnDcolon
sig' <- markAnnotated sig
return (ExprWithTySig an0 expr' sig')
exact (ArithSeq an s seqInfo) = do
- an0 <- markEpAnnL an lidl AnnOpenS -- '['
+ an0 <- markEpAnnL' an lidl AnnOpenS -- '['
(an1, seqInfo') <-
case seqInfo of
From e -> do
e' <- markAnnotated e
- an' <- markEpAnnL an0 lidl AnnDotdot
+ an' <- markEpAnnL' an0 lidl AnnDotdot
return (an', From e')
FromTo e1 e2 -> do
e1' <- markAnnotated e1
- an' <- markEpAnnL an0 lidl AnnDotdot
+ an' <- markEpAnnL' an0 lidl AnnDotdot
e2' <- markAnnotated e2
return (an', FromTo e1' e2')
FromThen e1 e2 -> do
e1' <- markAnnotated e1
- an' <- markEpAnnL an0 lidl AnnComma
+ an' <- markEpAnnL' an0 lidl AnnComma
e2' <- markAnnotated e2
- an'' <- markEpAnnL an' lidl AnnDotdot
+ an'' <- markEpAnnL' an' lidl AnnDotdot
return (an'', FromThen e1' e2')
FromThenTo e1 e2 e3 -> do
e1' <- markAnnotated e1
- an' <- markEpAnnL an0 lidl AnnComma
+ an' <- markEpAnnL' an0 lidl AnnComma
e2' <- markAnnotated e2
- an'' <- markEpAnnL an' lidl AnnDotdot
+ an'' <- markEpAnnL' an' lidl AnnDotdot
e3' <- markAnnotated e3
return (an'', FromThenTo e1' e2' e3')
- an2 <- markEpAnnL an1 lidl AnnCloseS -- ']'
+ an2 <- markEpAnnL' an1 lidl AnnCloseS -- ']'
return (ArithSeq an2 s seqInfo')
exact (HsTypedBracket an e) = do
- an0 <- markEpAnnLMS an lidl AnnOpen (Just "[||")
- an1 <- markEpAnnLMS an0 lidl AnnOpenE (Just "[e||")
+ an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[||")
+ an1 <- markEpAnnLMS'' an0 lidl AnnOpenE (Just "[e||")
e' <- markAnnotated e
- an2 <- markEpAnnLMS an1 lidl AnnClose (Just "||]")
+ an2 <- markEpAnnLMS'' an1 lidl AnnClose (Just "||]")
return (HsTypedBracket an2 e')
exact (HsUntypedBracket an (ExpBr a e)) = do
- an0 <- markEpAnnL an lidl AnnOpenEQ -- "[|"
- an1 <- markEpAnnL an0 lidl AnnOpenE -- "[e|" -- optional
+ an0 <- markEpAnnL' an lidl AnnOpenEQ -- "[|"
+ an1 <- markEpAnnL' an0 lidl AnnOpenE -- "[e|" -- optional
e' <- markAnnotated e
- an2 <- markEpAnnL an1 lidl AnnCloseQ -- "|]"
+ an2 <- markEpAnnL' an1 lidl AnnCloseQ -- "|]"
return (HsUntypedBracket an2 (ExpBr a e'))
exact (HsUntypedBracket an (PatBr a e)) = do
- an0 <- markEpAnnLMS an lidl AnnOpen (Just "[p|")
+ an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[p|")
e' <- markAnnotated e
- an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"
+ an1 <- markEpAnnL' an0 lidl AnnCloseQ -- "|]"
return (HsUntypedBracket an1 (PatBr a e'))
exact (HsUntypedBracket an (DecBrL a e)) = do
- an0 <- markEpAnnLMS an lidl AnnOpen (Just "[d|")
- an1 <- markEpAnnL an0 lidl AnnOpenC
+ an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[d|")
+ an1 <- markEpAnnL' an0 lidl AnnOpenC
e' <- markAnnotated e
- an2 <- markEpAnnL an1 lidl AnnCloseC
- an3 <- markEpAnnL an2 lidl AnnCloseQ -- "|]"
+ an2 <- markEpAnnL' an1 lidl AnnCloseC
+ an3 <- markEpAnnL' an2 lidl AnnCloseQ -- "|]"
return (HsUntypedBracket an3 (DecBrL a e'))
exact (HsUntypedBracket an (TypBr a e)) = do
- an0 <- markEpAnnLMS an lidl AnnOpen (Just "[t|")
+ an0 <- markEpAnnLMS'' an lidl AnnOpen (Just "[t|")
e' <- markAnnotated e
- an1 <- markEpAnnL an0 lidl AnnCloseQ -- "|]"
+ an1 <- markEpAnnL' an0 lidl AnnCloseQ -- "|]"
return (HsUntypedBracket an1 (TypBr a e'))
exact (HsUntypedBracket an (VarBr a b e)) = do
(an0, e') <- if b
then do
- an' <- markEpAnnL an lidl AnnSimpleQuote
+ an' <- markEpAnnL' an lidl AnnSimpleQuote
e' <- markAnnotated e
return (an', e')
else do
- an' <- markEpAnnL an lidl AnnThTyQuote
+ an' <- markEpAnnL' an lidl AnnThTyQuote
e' <- markAnnotated e
return (an', e')
return (HsUntypedBracket an0 (VarBr a b e'))
- exact (HsTypedSplice (x,an) s) = do
- an0 <- markEpAnnL an lidl AnnDollarDollar
+ exact (HsTypedSplice an s) = do
+ an0 <- markEpAnnL' an lidl AnnDollarDollar
s' <- exact s
- return (HsTypedSplice (x,an0) s')
+ return (HsTypedSplice an0 s')
+
exact (HsUntypedSplice an s) = do
s' <- exact s
return (HsUntypedSplice an s')
exact (HsProc an p c) = do
debugM $ "HsProc start"
- an0 <- markEpAnnL an lidl AnnProc
+ an0 <- markEpAnnL' an lidl AnnProc
p' <- markAnnotated p
- an1 <- markEpAnnL an0 lidl AnnRarrow
+ an1 <- markEpAnnL' an0 lidl AnnRarrow
debugM $ "HsProc after AnnRarrow"
c' <- markAnnotated c
return (HsProc an1 p' c')
exact (HsStatic an e) = do
- an0 <- markEpAnnL an lidl AnnStatic
+ an0 <- markEpAnnL' an lidl AnnStatic
e' <- markAnnotated e
return (HsStatic an0 e')
@@ -3357,14 +3280,12 @@ instance ExactPrint (HsPragE GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (HsUntypedSplice GhcPs) where
- getAnnotationEntry (HsUntypedSpliceExpr an _) = fromAnn an
- getAnnotationEntry (HsQuasiQuote _ _ _) = NoEntryVal
+ getAnnotationEntry _ = NoEntryVal
- setAnnotationAnchor (HsUntypedSpliceExpr an e) anc ts cs = HsUntypedSpliceExpr (setAnchorEpa an anc ts cs) e
- setAnnotationAnchor a at HsQuasiQuote {} _ _ _= a
+ setAnnotationAnchor a _ _ _= a
exact (HsUntypedSpliceExpr an e) = do
- an0 <- markEpAnnL an lidl AnnDollar
+ an0 <- markEpAnnL' an lidl AnnDollar
e' <- markAnnotated e
return (HsUntypedSpliceExpr an0 e')
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f0e07d824988133cd70d5020c0e8d6701f94b99
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f0e07d824988133cd70d5020c0e8d6701f94b99
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/f1367e56/attachment-0001.html>
More information about the ghc-commits
mailing list