[Git][ghc/ghc][wip/az/epa-hslet-tokens] 3 commits: EPA: Remove some unneeded helpers from Parser.y
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sat Dec 16 17:23:13 UTC 2023
Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
95e75b05 by Alan Zimmerman at 2023-12-16T15:28:04+00:00
EPA: Remove some unneeded helpers from Parser.y
- - - - -
929bad3a by Alan Zimmerman at 2023-12-16T16:37:25+00:00
EPA: remove double calculation from acs and acsA
- - - - -
7cee320f by Alan Zimmerman at 2023-12-16T17:20:32+00:00
EPA: remove more uneccesary helpers in Parser.y
- - - - -
2 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -758,10 +758,10 @@ identifier :: { LocatedN RdrName }
| qcon { $1 }
| qvarop { $1 }
| qconop { $1 }
- | '(' '->' ')' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
- (NameAnnRArrow (isUnicode $2) (Just $ glAA $1) (glAA $2) (Just $ glAA $3) []) }
- | '->' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
- (NameAnnRArrow (isUnicode $1) Nothing (glAA $1) Nothing []) }
+ | '(' '->' ')' {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
+ (NameAnnRArrow (isUnicode $2) (Just $ glAA $1) (glAA $2) (Just $ glAA $3) []) }
+ | '->' {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
+ (NameAnnRArrow (isUnicode $1) Nothing (glAA $1) Nothing []) }
-----------------------------------------------------------------------------
-- Backpack stuff
@@ -880,7 +880,7 @@ unitdecl :: { LHsUnitDecl PackageName }
signature :: { Located (HsModule GhcPs) }
: 'signature' modid maybe_warning_pragma maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
- acs (\cs-> (L loc (HsModule (XModulePs
+ acs loc (\loc cs-> (L loc (HsModule (XModulePs
(EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6) Nothing) cs)
(thdOf3 $6) $3 Nothing)
(Just $2) $4 (fst $ sndOf3 $6)
@@ -938,14 +938,14 @@ top1 :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }
header :: { Located (HsModule GhcPs) }
: 'module' modid maybe_warning_pragma maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
- acs (\cs -> (L loc (HsModule (XModulePs
+ acs loc (\loc cs -> (L loc (HsModule (XModulePs
(EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
))) }
| 'signature' modid maybe_warning_pragma maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
- acs (\cs -> (L loc (HsModule (XModulePs
+ acs loc (\loc cs -> (L loc (HsModule (XModulePs
(EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
@@ -973,7 +973,7 @@ header_top_importdecls :: { [LImportDecl GhcPs] }
-- The Export List
maybeexports :: { (Maybe (LocatedL [LIE GhcPs])) }
- : '(' exportlist ')' {% fmap Just $ amsrl (sLL $1 $> (fromOL $ snd $2))
+ : '(' exportlist ')' {% fmap Just $ amsr (sLL $1 $> (fromOL $ snd $2))
(AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) []) }
| {- empty -} { Nothing }
@@ -1103,7 +1103,7 @@ importdecl :: { LImportDecl GhcPs }
, importDeclAnnAs = fst $8
}
; let loc = (comb5 $1 $6 $7 (snd $8) $9);
- ; fmap reLoc $ acs (\cs -> L loc $
+ ; fmap reLoc $ acs loc (\loc cs -> L loc $
ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
@@ -1148,10 +1148,10 @@ maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs]
| {- empty -} { noLoc Nothing }
impspec :: { Located (ImportListInterpretation, LocatedL [LIE GhcPs]) }
- : '(' importlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2)
+ : '(' importlist ')' {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $2)
(AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) [])
; return $ sLL $1 $> (Exactly, es)} }
- | 'hiding' '(' importlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3)
+ | 'hiding' '(' importlist ')' {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $3)
(AnnList Nothing (Just $ mop $2) (Just $ mcp $4) (mj AnnHiding $1:fst $3) [])
; return $ sLL $1 $> (EverythingBut, es)} }
@@ -1368,13 +1368,13 @@ inst_decl :: { LInstDecl GhcPs }
:(fst $ unLoc $5)++(fst $ unLoc $6)) }
overlap_pragma :: { Maybe (LocatedP OverlapMode) }
- : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsrp (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
+ : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
(AnnPragma (mo $1) (mc $2) []) }
- | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsrp (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))
+ | '{-# OVERLAPPING' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlapping (getOVERLAPPING_PRAGs $1)))
(AnnPragma (mo $1) (mc $2) []) }
- | '{-# OVERLAPS' '#-}' {% fmap Just $ amsrp (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))
+ | '{-# OVERLAPS' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlaps (getOVERLAPS_PRAGs $1)))
(AnnPragma (mo $1) (mc $2) []) }
- | '{-# INCOHERENT' '#-}' {% fmap Just $ amsrp (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))
+ | '{-# INCOHERENT' '#-}' {% fmap Just $ amsr (sLL $1 $> (Incoherent (getINCOHERENT_PRAGs $1)))
(AnnPragma (mo $1) (mc $2) []) }
| {- empty -} { Nothing }
@@ -1570,14 +1570,14 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs
-- T Int [a] -- for associated types
-- Rather a lot of inlining here, else we get reduce/reduce errors
tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) }
- : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) }
+ : context '=>' type {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), $3))) }
| type { sL1 $1 (Nothing, $1) }
datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) }
: 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1
>> fromSpecTyVarBndrs $2
>>= \tvbs ->
- (acs (\cs -> (sLL $1 $>
+ (acs (comb2 $1 $>) (\loc cs -> (L loc
(Just ( addTrailingDarrowC $4 $5 cs)
, mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6))))
}
@@ -1587,18 +1587,18 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs
; cs <- getCommentsFor loc
; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4))
} }
- | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) }
+ | context '=>' type {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) }
| type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }
capi_ctype :: { Maybe (LocatedP CType) }
capi_ctype : '{-# CTYPE' STRING STRING '#-}'
- {% fmap Just $ amsrp (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
+ {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) (Just (Header (getSTRINGs $2) (getSTRING $2)))
(getSTRINGs $3,getSTRING $3)))
(AnnPragma (mo $1) (mc $4) [mj AnnHeader $2,mj AnnVal $3]) }
| '{-# CTYPE' STRING '#-}'
- {% fmap Just $ amsrp (sLL $1 $> (CType (getCTYPEs $1) Nothing (getSTRINGs $2, getSTRING $2)))
+ {% fmap Just $ amsr (sLL $1 $> (CType (getCTYPEs $1) Nothing (getSTRINGs $2, getSTRING $2)))
(AnnPragma (mo $1) (mc $3) [mj AnnVal $2]) }
| { Nothing }
@@ -1674,9 +1674,9 @@ cvars1 :: { [RecordPatSynField GhcPs] }
; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}}
where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) }
- : 'where' '{' decls '}' {% amsrl (sLL $1 $> (snd $ unLoc $3))
+ : 'where' '{' decls '}' {% amsr (sLL $1 $> (snd $ unLoc $3))
(AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) }
- | 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3))
+ | 'where' vocurly decls close {% amsr (sLL $1 $3 (snd $ unLoc $3))
(AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) }
pattern_synonym_sig :: { LSig GhcPs }
@@ -1828,18 +1828,18 @@ binds :: { Located (HsLocalBinds GhcPs) }
; cs <- getCommentsFor (gl $1)
; return (sL1 $1 $ HsValBinds (fixValbindsAnn $ EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds)} }
- | '{' dbinds '}' {% acs (\cs -> (L (comb3 $1 $2 $3)
+ | '{' dbinds '}' {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc
$ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }
- | vocurly dbinds close {% acs (\cs -> (L (gl $2)
+ | vocurly dbinds close {% acs (gl $2) (\loc cs -> (L loc
$ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) Nothing Nothing [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }
wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) }
-- May have implicit parameters
-- No type declarations
- : 'where' binds {% do { r <- acs (\cs ->
- (sLL $1 $> (annBinds (mj AnnWhere $1) cs (unLoc $2))))
+ : 'where' binds {% do { r <- acs (comb2 $1 $>) (\loc cs ->
+ (L loc (annBinds (mj AnnWhere $1) cs (unLoc $2))))
; return $ Just r} }
| {- empty -} { Nothing }
@@ -1954,10 +1954,10 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
: '{-# DEPRECATED' strings '#-}'
- {% fmap Just $ amsrp (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
+ {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
(AnnPragma (mo $1) (mc $3) (fst $ unLoc $2)) }
| '{-# WARNING' warning_category strings '#-}'
- {% fmap Just $ amsrp (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
+ {% fmap Just $ amsr (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
(AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
| {- empty -} { Nothing }
@@ -2134,11 +2134,11 @@ unpackedness :: { Located UnpackednessPragma }
forall_telescope :: { Located (HsForAllTelescope GhcPs) }
: 'forall' tv_bndrs '.' {% do { hintExplicitForall $1
- ; acs (\cs -> (sLL $1 $> $
+ ; acs (comb2 $1 $>) (\loc cs -> (L loc $
mkHsForAllInvisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnDot $3) cs) $2 )) }}
| 'forall' tv_bndrs '->' {% do { hintExplicitForall $1
; req_tvbs <- fromSpecTyVarBndrs $2
- ; acs (\cs -> (sLL $1 $> $
+ ; acs (comb2 $1 $>) (\loc cs -> (L loc $
mkHsForAllVisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnRarrow $3) cs) req_tvbs )) }}
-- A ktype is a ctype, possibly with a kind annotation
@@ -2152,7 +2152,7 @@ ctype :: { LHsType GhcPs }
HsForAllTy { hst_tele = unLoc $1
, hst_xforall = noExtField
, hst_body = $2 } }
- | context '=>' ctype {% acsA (\cs -> (sLL $1 $> $
+ | context '=>' ctype {% acsA (comb2 $1 $>) (\loc cs -> (L loc $
HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs
, hst_xqual = NoExtField
, hst_body = $3 })) }
@@ -2232,11 +2232,11 @@ tyarg :: { LHsType GhcPs }
tyop :: { (LocatedN RdrName, PromotionFlag) }
: qtyconop { ($1, NotPromoted) }
| tyvarop { ($1, NotPromoted) }
- | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 $> (unLoc $2))
- (NameAnnQuote (glAA $1) (gl $2) [])
+ | SIMPLEQUOTE qconop {% do { op <- amsr (sLL $1 $> (unLoc $2))
+ (NameAnnQuote (glAA $1) (gl $2) [])
; return (op, IsPromoted) } }
- | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 $> (unLoc $2))
- (NameAnnQuote (glAA $1) (gl $2) [])
+ | SIMPLEQUOTE varop {% do { op <- amsr (sLL $1 $> (unLoc $2))
+ (NameAnnQuote (glAA $1) (gl $2) [])
; return (op, IsPromoted) } }
atype :: { LHsType GhcPs }
@@ -2514,10 +2514,10 @@ deriv_clause_types :: { LDerivClauseTys GhcPs }
: qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $
sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in
sL1a $1 (DctSingle noExtField tc) }
- | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField []))
- (AnnContext Nothing [glAA $1] [glAA $2]) }
- | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2))
- (AnnContext Nothing [glAA $1] [glAA $3])}
+ | '(' ')' {% amsr (sLL $1 $> (DctMulti noExtField []))
+ (AnnContext Nothing [glAA $1] [glAA $2]) }
+ | '(' deriv_types ')' {% amsr (sLL $1 $> (DctMulti noExtField $2))
+ (AnnContext Nothing [glAA $1] [glAA $3])}
-----------------------------------------------------------------------------
-- Value definitions
@@ -2581,11 +2581,11 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }
do { let L l (bs, csw) = adaptWhereBinds $3
; let loc = (comb3 $1 $2 (L l bs))
; let locg = (comb2 $1 $2)
- ; acs (\cs ->
- sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs locg) (GrhsAnn Nothing (mj AnnEqual $1)) cs) locg $2)
+ ; acs loc (\loc cs ->
+ sL loc (GRHSs csw (unguardedRHS (EpAnn (spanAsAnchor locg) (GrhsAnn Nothing (mj AnnEqual $1)) cs) locg $2)
bs)) } }
| gdrhs wherebinds {% do { let {L l (bs, csw) = adaptWhereBinds $2}
- ; acs (\cs -> sL (comb2 $1 (L l bs))
+ ; acs (comb2 $1 (L l bs)) (\loc cs -> L loc
(GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }}
gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
@@ -2594,7 +2594,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
: '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 ->
- acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) }
+ acsA (comb2 $1 $>) (\loc cs -> L loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) }
sigdecl :: { LHsDecl GhcPs }
:
@@ -2986,10 +2986,10 @@ aexp2 :: { ECP }
[moh $1,mch $3] }
| '[' list ']' { ECP $ $2 (comb2 $1 $>) (mos $1,mcs $3) }
- | '_' { ECP $ pvA $ mkHsWildCardPV (getLoc $1) }
+ | '_' { ECP $ mkHsWildCardPV (getLoc $1) }
-- Template Haskell Extension
- | splice_untyped { ECP $ pvA' $ mkHsSplicePV $1 }
+ | splice_untyped { ECP $ mkHsSplicePV $1 }
| splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLoc $1) }
| SIMPLEQUOTE qvar {% fmap ecpFromExp $ amsA' (sLL $1 $> $ HsUntypedBracket [mj AnnSimpleQuote $1] (VarBr noExtField True $2)) }
@@ -3012,7 +3012,7 @@ aexp2 :: { ECP }
amsA' (sLL $1 $> $ HsUntypedBracket [mo $1,mu AnnCloseQ $3] (PatBr noExtField p)) }
| '[d|' cvtopbody '|]' {% fmap ecpFromExp $
amsA' (sLL $1 $> $ HsUntypedBracket (mo $1:mu AnnCloseQ $3:fst $2) (DecBrL noExtField (snd $2))) }
- | quasiquote { ECP $ pvA' $ mkHsSplicePV $1 }
+ | quasiquote { ECP $ mkHsSplicePV $1 }
-- arrow notation extension
| '(|' aexp cmdargs '|)' {% runPV (unECP $2) >>= \ $2 ->
@@ -3090,7 +3090,7 @@ texp :: { ECP }
superInfixOp $
unECP $2 >>= \ $2 ->
$1 >>= \ $1 ->
- pvA' $ mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 }
+ mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 }
-- View patterns get parenthesized above
| exp '->' texp { ECP $
@@ -3110,7 +3110,7 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
; return (Tuple (Right t : snd $2)) } }
| commas tup_tail
{ $2 >>= \ $2 ->
- do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) True emptyComments))) (fst $1) }
+ do { let {cos = map (\ll -> (Left (EpAnn (spanAsAnchor ll) True emptyComments))) (fst $1) }
; return (Tuple (cos ++ $2)) } }
| texp bars { unECP $1 >>= \ $1 -> return $
@@ -3126,7 +3126,7 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) }
commas_tup_tail : commas tup_tail
{ $2 >>= \ $2 ->
- do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) True emptyComments))) (tail $ fst $1) }
+ do { let {cos = map (\l -> (Left (EpAnn (spanAsAnchor l) True emptyComments))) (tail $ fst $1) }
; return ((head $ fst $1, cos ++ $2)) } }
-- Always follows a comma
@@ -3219,14 +3219,14 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau
{% case unLoc $1 of
(h:t) -> do
h' <- addTrailingCommaA h (gl $2)
- return (sLL $1 $> [sLLa $1 $> ((unLoc $3) (glRR $1) (reverse (h':t)))]) }
+ return (sLL $1 $> [sLLa $1 $> ((unLoc $3) (reverse (h':t)))]) }
| squals ',' qual
{% runPV $3 >>= \ $3 ->
case unLoc $1 of
(h:t) -> do
h' <- addTrailingCommaA h (gl $2)
return (sLL $1 $> ($3 : (h':t))) }
- | transformqual { sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])] }
+ | transformqual { sLL $1 $> [L (getLocAnn $1) ((unLoc $1) [])] }
| qual {% runPV $1 >>= \ $1 ->
return $ sL1 $1 [$1] }
-- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) }
@@ -3237,22 +3237,22 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau
-- consensus on the syntax, this feature is not being used until we
-- get user demand.
-transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
+transformqual :: { Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
-- Function is applied to a list of stmts *in order*
: 'then' exp {% runPV (unECP $2) >>= \ $2 ->
return (
- sLL $1 $> (\r ss -> (mkTransformStmt [mj AnnThen $1] ss $2))) }
+ sLL $1 $> (\ss -> (mkTransformStmt [mj AnnThen $1] ss $2))) }
| 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 ->
runPV (unECP $4) >>= \ $4 ->
- return (sLL $1 $> (\r ss -> (mkTransformByStmt [mj AnnThen $1,mj AnnBy $3] ss $2 $4))) }
+ return (sLL $1 $> (\ss -> (mkTransformByStmt [mj AnnThen $1,mj AnnBy $3] ss $2 $4))) }
| 'then' 'group' 'using' exp
{% runPV (unECP $4) >>= \ $4 ->
- return (sLL $1 $> (\r ss -> (mkGroupUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] ss $4))) }
+ return (sLL $1 $> (\ss -> (mkGroupUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] ss $4))) }
| 'then' 'group' 'by' exp 'using' exp
{% runPV (unECP $4) >>= \ $4 ->
runPV (unECP $6) >>= \ $6 ->
- return (sLL $1 $> (\r ss -> (mkGroupByUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] ss $4 $6))) }
+ return (sLL $1 $> (\ss -> (mkGroupByUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] ss $4 $6))) }
-- Note that 'group' is a special_id, which means that you can enable
-- TransformListComp while still using Data.List.group. However, this
@@ -3278,13 +3278,13 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
-- Case alternatives
altslist(PATS) :: { forall b. DisambECP b => PV (LocatedL [LMatch GhcPs (LocatedA b)]) }
- : '{' alts(PATS) '}' { $2 >>= \ $2 -> amsrl
+ : '{' alts(PATS) '}' { $2 >>= \ $2 -> amsr
(sLL $1 $> (reverse (snd $ unLoc $2)))
(AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) []) }
- | vocurly alts(PATS) close { $2 >>= \ $2 -> amsrl
+ | vocurly alts(PATS) close { $2 >>= \ $2 -> amsr
(L (getLoc $2) (reverse (snd $ unLoc $2)))
(AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []) }
- | '{' '}' { amsrl (sLL $1 $> []) (AnnList Nothing (Just $ moc $1) (Just $ mcc $2) [] []) }
+ | '{' '}' { amsr (sLL $1 $> []) (AnnList Nothing (Just $ moc $1) (Just $ mcc $2) [] []) }
| vocurly close { return $ noLocA [] }
alts(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (LocatedA b)])) }
@@ -3314,7 +3314,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs
alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
: PATS alt_rhs { $2 >>= \ $2 ->
- acsA (\cs -> sLLAsl $1 $>
+ acsA (sLLAsl $1 $> ()) (\loc cs -> L (locA loc)
(Match { m_ext = []
, m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing
, m_pats = $1
@@ -3323,11 +3323,11 @@ alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) }
: ralt wherebinds { $1 >>= \alt ->
do { let {L l (bs, csw) = adaptWhereBinds $2}
- ; acs (\cs -> sLL alt (L l bs) (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) }}
+ ; acs (comb2 alt (L l bs)) (\loc cs -> L loc (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) }}
ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) }
: '->' exp { unECP $2 >>= \ $2 ->
- acs (\cs -> sLL $1 $> (unguardedRHS (EpAnn (spanAsAnchor $ comb2 $1 $2) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) }
+ acs (comb2 $1 $>) (\loc cs -> L loc (unguardedRHS (EpAnn (spanAsAnchor $ comb2 $1 $2) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) }
| gdpats { $1 >>= \gdpats ->
return $ sL1 gdpats (reverse (unLoc gdpats)) }
@@ -3349,7 +3349,7 @@ ifgdpats :: { Located ([AddEpAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b)) }
: '|' guardquals '->' exp
{ unECP $4 >>= \ $4 ->
- acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) }
+ acsA (comb2 $1 $>) (\loc cs -> sL loc $ GRHS (EpAnn (glEE $1 $>) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) }
-- 'pat' recognises a pattern, including one with a bang at the top
-- e.g. "!x" or "!(x,y)" or "C a b" etc
@@ -3380,8 +3380,8 @@ apats :: { [LPat GhcPs] }
stmtlist :: { forall b. DisambECP b => PV (LocatedL [LocatedA (Stmt GhcPs (LocatedA b))]) }
: '{' stmts '}' { $2 >>= \ $2 ->
- amsrl (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) (Just $ moc $1) (Just $ mcc $3) (fromOL $ fst $ unLoc $2) []) }
- | vocurly stmts close { $2 >>= \ $2 -> amsrl
+ amsr (sLL $1 $> (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) (Just $ moc $1) (Just $ mcc $3) (fromOL $ fst $ unLoc $2) []) }
+ | vocurly stmts close { $2 >>= \ $2 -> amsr
(L (stmtsLoc $2) (reverse $ snd $ unLoc $2)) (AnnList (stmtsAnchor $2) Nothing Nothing (fromOL $ fst $ unLoc $2) []) }
-- do { ;; s ; s ; ; s ;; }
@@ -3553,7 +3553,7 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] }
; return (h : $3) } }
name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) }
- : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2))
+ : '(' name_boolformula ')' {% amsr (sLL $1 $> (Parens $2))
(AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) }
| name_var { sL1a $1 (Var $1) }
@@ -3581,13 +3581,13 @@ qcon :: { LocatedN RdrName }
gen_qcon :: { LocatedN RdrName }
: qconid { $1 }
- | '(' qconsym ')' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ | '(' qconsym ')' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
con :: { LocatedN RdrName }
: conid { $1 }
- | '(' consym ')' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ | '(' consym ')' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
| sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) }
con_list :: { Located (NonEmpty (LocatedN RdrName)) }
@@ -3601,27 +3601,27 @@ qcon_list : qcon { sL1 $1 [$1] }
-- See Note [ExplicitTuple] in GHC.Hs.Expr
sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors
- : '(' ')' {% amsrn (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }
- | '(' commas ')' {% amsrn (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
+ : '(' ')' {% amsr (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }
+ | '(' commas ')' {% amsr (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
(NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
- | '(#' '#)' {% amsrn (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }
- | '(#' commas '#)' {% amsrn (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
+ | '(#' '#)' {% amsr (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }
+ | '(#' commas '#)' {% amsr (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
(NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
-- See Note [Empty lists] in GHC.Hs.Expr
sysdcon :: { LocatedN DataCon }
: sysdcon_nolist { $1 }
- | '[' ']' {% amsrn (sLL $1 $> nilDataCon) (NameAnnOnly NameSquare (glAA $1) (glAA $2) []) }
+ | '[' ']' {% amsr (sLL $1 $> nilDataCon) (NameAnnOnly NameSquare (glAA $1) (glAA $2) []) }
conop :: { LocatedN RdrName }
: consym { $1 }
- | '`' conid '`' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
+ | '`' conid '`' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
qconop :: { LocatedN RdrName }
: qconsym { $1 }
- | '`' qconid '`' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
+ | '`' qconid '`' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
----------------------------------------------------------------------------
-- Type constructors
@@ -3631,30 +3631,30 @@ qconop :: { LocatedN RdrName }
-- between gtycon and ntgtycon
gtycon :: { LocatedN RdrName } -- A "general" qualified tycon, including unit tuples
: ntgtycon { $1 }
- | '(' ')' {% amsrn (sLL $1 $> $ getRdrName unitTyCon)
- (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }
- | '(#' '#)' {% amsrn (sLL $1 $> $ getRdrName unboxedUnitTyCon)
- (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }
+ | '(' ')' {% amsr (sLL $1 $> $ getRdrName unitTyCon)
+ (NameAnnOnly NameParens (glAA $1) (glAA $2) []) }
+ | '(#' '#)' {% amsr (sLL $1 $> $ getRdrName unboxedUnitTyCon)
+ (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) }
ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit tuples
: oqtycon { $1 }
- | '(' commas ')' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Boxed
- (snd $2 + 1)))
+ | '(' commas ')' {% amsr (sLL $1 $> $ getRdrName (tupleTyCon Boxed
+ (snd $2 + 1)))
(NameAnnCommas NameParens (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
- | '(#' commas '#)' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
- (snd $2 + 1)))
+ | '(#' commas '#)' {% amsr (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
+ (snd $2 + 1)))
(NameAnnCommas NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
- | '(#' bars '#)' {% amsrn (sLL $1 $> $ getRdrName (sumTyCon (snd $2 + 1)))
+ | '(#' bars '#)' {% amsr (sLL $1 $> $ getRdrName (sumTyCon (snd $2 + 1)))
(NameAnnBars NameParensHash (glAA $1) (map srcSpan2e (fst $2)) (glAA $3) []) }
- | '(' '->' ')' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
+ | '(' '->' ')' {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
(NameAnnRArrow (isUnicode $2) (Just $ glAA $1) (glAA $2) (Just $ glAA $3) []) }
- | '[' ']' {% amsrn (sLL $1 $> $ listTyCon_RDR)
+ | '[' ']' {% amsr (sLL $1 $> $ listTyCon_RDR)
(NameAnnOnly NameSquare (glAA $1) (glAA $2) []) }
oqtycon :: { LocatedN RdrName } -- An "ordinary" qualified tycon;
-- These can appear in export lists
: qtycon { $1 }
- | '(' qtyconsym ')' {% amsrn (sLL $1 $> (unLoc $2))
+ | '(' qtyconsym ')' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
oqtycon_no_varcon :: { LocatedN RdrName } -- Type constructor which cannot be mistaken
@@ -3663,13 +3663,13 @@ oqtycon_no_varcon :: { LocatedN RdrName } -- Type constructor which cannot be m
: qtycon { $1 }
| '(' QCONSYM ')' {% let { name :: Located RdrName
; name = sL1 $2 $! mkQual tcClsName (getQCONSYM $2) }
- in amsrn (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
| '(' CONSYM ')' {% let { name :: Located RdrName
; name = sL1 $2 $! mkUnqual tcClsName (getCONSYM $2) }
- in amsrn (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
| '(' ':' ')' {% let { name :: Located RdrName
; name = sL1 $2 $! consDataCon_RDR }
- in amsrn (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ in amsr (sLL $1 $> (unLoc name)) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
{- Note [Type constructors in export list]
~~~~~~~~~~~~~~~~~~~~~
@@ -3694,8 +3694,8 @@ child.
qtyconop :: { LocatedN RdrName } -- Qualified or unqualified
-- See Note [%shift: qtyconop -> qtyconsym]
: qtyconsym %shift { $1 }
- | '`' qtycon '`' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
+ | '`' qtycon '`' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
qtycon :: { LocatedN RdrName } -- Qualified or unqualified
: QCONID { sL1n $1 $! mkQual tcClsName (getQCONID $1) }
@@ -3720,8 +3720,8 @@ tyconsym :: { LocatedN RdrName }
-- These can appear in `ANN type` declarations (#19374).
otycon :: { LocatedN RdrName }
: tycon { $1 }
- | '(' tyconsym ')' {% amsrn (sLL $1 $> (unLoc $2))
- (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
+ | '(' tyconsym ')' {% amsr (sLL $1 $> (unLoc $2))
+ (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
-----------------------------------------------------------------------------
-- Operators
@@ -3729,12 +3729,12 @@ otycon :: { LocatedN RdrName }
op :: { LocatedN RdrName } -- used in infix decls
: varop { $1 }
| conop { $1 }
- | '->' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
+ | '->' {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
(NameAnnRArrow (isUnicode $1) Nothing (glAA $1) Nothing []) }
varop :: { LocatedN RdrName }
: varsym { $1 }
- | '`' varid '`' {% amsrn (sLL $1 $> (unLoc $2))
+ | '`' varid '`' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
qop :: { forall b. DisambInfixOp b => PV (LocatedN b) } -- used in sections
@@ -3752,12 +3752,12 @@ hole_op : '`' '_' '`' { sLLa $1 $> (hsHoleExpr (Just $ EpAnnUnboundVar
qvarop :: { LocatedN RdrName }
: qvarsym { $1 }
- | '`' qvarid '`' {% amsrn (sLL $1 $> (unLoc $2))
+ | '`' qvarid '`' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
qvaropm :: { LocatedN RdrName }
: qvarsym_no_minus { $1 }
- | '`' qvarid '`' {% amsrn (sLL $1 $> (unLoc $2))
+ | '`' qvarid '`' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
-----------------------------------------------------------------------------
@@ -3767,7 +3767,7 @@ tyvar :: { LocatedN RdrName }
tyvar : tyvarid { $1 }
tyvarop :: { LocatedN RdrName }
-tyvarop : '`' tyvarid '`' {% amsrn (sLL $1 $> (unLoc $2))
+tyvarop : '`' tyvarid '`' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameBackquotes (glAA $1) (glAA $2) (glAA $3) []) }
tyvarid :: { LocatedN RdrName }
@@ -3785,14 +3785,14 @@ tyvarid :: { LocatedN RdrName }
var :: { LocatedN RdrName }
: varid { $1 }
- | '(' varsym ')' {% amsrn (sLL $1 $> (unLoc $2))
+ | '(' varsym ')' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
qvar :: { LocatedN RdrName }
: qvarid { $1 }
- | '(' varsym ')' {% amsrn (sLL $1 $> (unLoc $2))
+ | '(' varsym ')' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
- | '(' qvarsym1 ')' {% amsrn (sLL $1 $> (unLoc $2))
+ | '(' qvarsym1 ')' {% amsr (sLL $1 $> (unLoc $2))
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
-- We've inlined qvarsym here so that the decision about
-- whether it's a qvar or a var can be postponed until
@@ -4285,22 +4285,12 @@ gl = getLoc
glA :: HasLoc a => a -> SrcSpan
glA = getHasLoc
-glRR :: Located a -> RealSrcSpan
-glRR = realSrcSpan . getLoc
-
glR :: HasLoc a => a -> Anchor
glR la = EpaSpan (getHasLoc la)
-glMR :: Maybe (Located a) -> Located b -> Anchor
-glMR (Just la) _ = glR la
-glMR _ la = glR la
-
glEE :: (HasLoc a, HasLoc b) => a -> b -> Anchor
glEE x y = spanAsAnchor $ comb2 x y
-anc :: RealSrcSpan -> Anchor
-anc r = EpaSpan (RealSrcSpan r Strict.Nothing)
-
glRM :: Located a -> Maybe Anchor
glRM (L l _) = Just $ spanAsAnchor l
@@ -4322,22 +4312,19 @@ acsFinal a = do
Strict.Just (pos `Strict.And` gap) -> Just (pos,gap)
return (a (cs Semi.<> csf) ce)
-acs :: (HasLoc t, MonadP m) => (EpAnnComments -> GenLocated t a) -> m (GenLocated t a)
-acs a = do
- let (L l _) = a emptyComments
+acs :: (HasLoc l, MonadP m) => l -> (l -> EpAnnComments -> GenLocated l a) -> m (GenLocated l a)
+acs l a = do
cs <- getCommentsFor (locA l)
- return (a cs)
+ return (a l cs)
-acsA :: (HasLoc t, HasAnnotation t, MonadP m) => (EpAnnComments -> Located a) -> m (GenLocated t a)
-acsA a = reLoc <$> acs a
-
-acsExpr :: (EpAnnComments -> LHsExpr GhcPs) -> P ECP
-acsExpr a = do { expr :: (LHsExpr GhcPs) <- runPV $ acs a
- ; return (ecpFromExp $ expr) }
+acsA :: (HasLoc l, HasAnnotation t, MonadP m) => l -> (l -> EpAnnComments -> Located a) -> m (GenLocated t a)
+acsA l a = do
+ cs <- getCommentsFor (locA l)
+ return $ reLoc (a l cs)
ams1 :: MonadP m => Located a -> b -> m (LocatedA b)
ams1 (L l a) b = do
- cs <- getCommentsFor (locA l)
+ cs <- getCommentsFor l
return (L (EpAnn (spanAsAnchor l) noAnn cs) b)
amsA' :: (NoAnn t, MonadP m) => Located a -> m (GenLocated (EpAnn t) a)
@@ -4355,23 +4342,8 @@ amsAl (L l a) loc bs = do
cs <- getCommentsFor loc
return (L (addAnnsA l bs cs) a)
-amsrc :: MonadP m => Located a -> AnnContext -> m (LocatedC a)
-amsrc a@(L l _) bs = do
- cs <- getCommentsFor l
- return (reAnnC bs cs a)
-
-amsrl :: MonadP m => Located a -> AnnList -> m (LocatedL a)
-amsrl a@(L l _) bs = do
- cs <- getCommentsFor l
- return (reAnnL bs cs a)
-
-amsrp :: MonadP m => Located a -> AnnPragma -> m (LocatedP a)
-amsrp a@(L l _) bs = do
- cs <- getCommentsFor l
- return (reAnnL bs cs a)
-
-amsrn :: MonadP m => Located a -> NameAnn -> m (LocatedN a)
-amsrn (L l a) an = do
+amsr :: MonadP m => Located a -> an -> m (LocatedAn an a)
+amsr (L l a) an = do
cs <- getCommentsFor l
return (L (EpAnn (spanAsAnchor l) an cs) a)
@@ -4396,22 +4368,6 @@ mos,mcs :: Located Token -> AddEpAnn
mos ll = mj AnnOpenS ll
mcs ll = mj AnnCloseS ll
-pvA :: (MonadP m, NoAnn t) => m (Located a) -> m (LocatedAn t a)
-pvA a = do { av <- a
- ; return (reLoc av) }
-
-pvA' :: (MonadP m, NoAnn t) => m (LocatedAn t a) -> m (LocatedAn t a)
-pvA' a = do { av <- a
- ; return av }
-
-pvN :: MonadP m => m (LocatedN a) -> m (LocatedN a)
-pvN a = do { (L l av) <- a
- ; return (L l av) }
-
-pvL :: MonadP m => m (LocatedAn t a) -> m (Located a)
-pvL a = do { av <- a
- ; return (reLoc av) }
-
-- | Parse a Haskell module with Haddock comments. This is done in two steps:
--
-- * 'parseModuleNoHaddock' to build the AST
@@ -4446,10 +4402,6 @@ commentsPA la@(L l a) = do
cs <- getPriorCommentsFor (getLocA la)
return (L (addCommentsToEpAnn l cs) a)
-rs :: SrcSpan -> RealSrcSpan
-rs (RealSrcSpan l _) = l
-rs _ = panic "Parser should only have RealSrcSpan"
-
hsDoAnn :: Located a -> LocatedAn t b -> AnnKeywordId -> AnnList
hsDoAnn (L l _) (L ll _) kw
= AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (srcSpan2e l)] []
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1586,7 +1586,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-- | Disambiguate an overloaded literal
mkHsOverLitPV :: LocatedAn a (HsOverLit GhcPs) -> PV (LocatedAn a b)
-- | Disambiguate a wildcard
- mkHsWildCardPV :: SrcSpan -> PV (Located b)
+ mkHsWildCardPV :: (NoAnn a) => SrcSpan -> PV (LocatedAn a b)
-- | Disambiguate "a :: t" (type annotation)
mkHsTySigPV
:: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b)
@@ -1810,7 +1810,7 @@ instance DisambECP (HsExpr GhcPs) where
mkHsOverLitPV (L (EpAnn l an csIn) a) = do
cs <- getCommentsFor (locA l)
return $ L (EpAnn l an (cs Semi.<> csIn)) (HsOverLit NoExtField a)
- mkHsWildCardPV l = return $ L l (hsHoleExpr noAnn)
+ mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (hsHoleExpr noAnn)
mkHsTySigPV l@(EpAnn anc an csIn) a sig anns = do
cs <- getCommentsFor (locA l)
return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExprWithTySig anns a (hsTypeToHsSigWcType sig))
@@ -1883,7 +1883,7 @@ instance DisambECP (PatBuilder GhcPs) where
cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (LitPat noExtField a))
mkHsOverLitPV (L l a) = return $ L l (PatBuilderOverLit a)
- mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
+ mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (PatBuilderPat (WildPat noExtField))
mkHsTySigPV l b sig anns = do
p <- checkLPat b
return $ L l (PatBuilderPat (SigPat anns p (mkHsPatSigType noAnn sig)))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63be32711753a83d4d8df82f003088bd84966b85...7cee320fadea91d1b7b9c4e623b1c10b103215a5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63be32711753a83d4d8df82f003088bd84966b85...7cee320fadea91d1b7b9c4e623b1c10b103215a5
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/20231216/cd99a516/attachment-0001.html>
More information about the ghc-commits
mailing list