diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-03-25 20:06:28 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-31 11:13:28 -0400 |
commit | 2fcebb72d97edd1e630002bef89bc6982529e36f (patch) | |
tree | f99af71a7e68e8a42b3223c069990554a5795786 /compiler | |
parent | dbadd672ba7da67533c34d8594ac7f91dde0f415 (diff) | |
download | haskell-2fcebb72d97edd1e630002bef89bc6982529e36f.tar.gz |
EPA : Rename AddApiAnn to AddEpAnn
As port of the process of migrating naming from API Annotations to
exact print annotations (EPA)
Follow-up from !2418, see #19579
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Hs.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Binds.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Hs/Decls.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Hs/Dump.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Hs/Pat.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Type.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 122 | ||||
-rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 58 | ||||
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 6 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 111 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Type.hs | 4 |
12 files changed, 173 insertions, 174 deletions
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index 26022e96de..171238a85a 100644 --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -126,7 +126,7 @@ deriving instance Data HsModule data AnnsModule = AnnsModule { - am_main :: [AddApiAnn], + am_main :: [AddEpAnn], am_decls :: AnnList } deriving (Data, Eq) diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 6383eb01b8..e40d1acc93 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -593,8 +593,8 @@ type instance XXFixitySig (GhcPass p) = NoExtCon data AnnSig = AnnSig { - asDcolon :: AddApiAnn, -- Not an AnnAnchor to capture unicode option - asRest :: [AddApiAnn] + asDcolon :: AddEpAnn, -- Not an AnnAnchor to capture unicode option + asRest :: [AddEpAnn] } deriving Data diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index e5e64267bf..bc0aaff318 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -1028,13 +1028,13 @@ type instance Anno (SourceText, RuleName) = SrcSpan data HsRuleAnn = HsRuleAnn - { ra_tyanns :: Maybe (AddApiAnn, AddApiAnn) + { ra_tyanns :: Maybe (AddEpAnn, AddEpAnn) -- ^ The locations of 'forall' and '.' for forall'd type vars - -- Using AddApiAnn to capture possible unicode variants - , ra_tmanns :: Maybe (AddApiAnn, AddApiAnn) + -- Using AddEpAnn to capture possible unicode variants + , ra_tmanns :: Maybe (AddEpAnn, AddEpAnn) -- ^ The locations of 'forall' and '.' for forall'd term vars - -- Using AddApiAnn to capture possible unicode variants - , ra_rest :: [AddApiAnn] + -- Using AddEpAnn to capture possible unicode variants + , ra_rest :: [AddEpAnn] } deriving (Data, Eq) flattenRuleDecls :: [LRuleDecls (GhcPass p)] -> [LRuleDecl (GhcPass p)] diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index 18605d3532..68ce567e46 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -54,7 +54,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan `extQ` annotation `extQ` annotationModule - `extQ` annotationAddApiAnn + `extQ` annotationAddEpAnn `extQ` annotationGrhsAnn `extQ` annotationApiAnnHsCase `extQ` annotationApiAnnHsLet @@ -178,12 +178,12 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 (text "")) - addApiAnn :: AddApiAnn -> SDoc - addApiAnn (AddApiAnn a s) = case ba of + addApiAnn :: AddEpAnn -> SDoc + addApiAnn (AddEpAnn a s) = case ba of BlankApiAnnotations -> parens - $ text "blanked:" <+> text "AddApiAnn" + $ text "blanked:" <+> text "AddEpAnn" NoBlankApiAnnotations -> - parens $ text "AddApiAnn" <+> ppr a <+> annAnchor s + parens $ text "AddEpAnn" <+> ppr a <+> annAnchor s var :: Var -> SDoc var v = braces $ text "Var:" <+> ppr v @@ -229,8 +229,8 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 annotationModule :: ApiAnn' AnnsModule -> SDoc annotationModule = annotation' (text "ApiAnn' AnnsModule") - annotationAddApiAnn :: ApiAnn' AddApiAnn -> SDoc - annotationAddApiAnn = annotation' (text "ApiAnn' AddApiAnn") + annotationAddEpAnn :: ApiAnn' AddEpAnn -> SDoc + annotationAddEpAnn = annotation' (text "ApiAnn' AddEpAnn") annotationGrhsAnn :: ApiAnn' GrhsAnn -> SDoc annotationGrhsAnn = annotation' (text "ApiAnn' GrhsAnn") diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 9d3e3dcf39..0659c0f654 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -209,7 +209,7 @@ could only do that if the extension field was strict (#18764) data ApiAnnHsCase = ApiAnnHsCase { hsCaseAnnCase :: AnnAnchor , hsCaseAnnOf :: AnnAnchor - , hsCaseAnnsRest :: [AddApiAnn] + , hsCaseAnnsRest :: [AddEpAnn] } deriving Data data ApiAnnUnboundVar = ApiAnnUnboundVar @@ -981,7 +981,7 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ************************************************************************ -} -type instance XCmdArrApp GhcPs = ApiAnn' AddApiAnn +type instance XCmdArrApp GhcPs = ApiAnn' AddEpAnn type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type @@ -1187,7 +1187,7 @@ type instance XXGRHSs (GhcPass _) _ = NoExtCon data GrhsAnn = GrhsAnn { ga_vbar :: Maybe AnnAnchor, -- TODO:AZ do we need this? - ga_sep :: AddApiAnn -- ^ Match separator location + ga_sep :: AddEpAnn -- ^ Match separator location } deriving (Data) type instance XCGRHS (GhcPass _) _ = ApiAnn' GrhsAnn diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index c5cd2ccb78..34b4b8e173 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -163,7 +163,7 @@ type instance XHsRecField _ = ApiAnn -- API Annotations types data ApiAnnSumPat = ApiAnnSumPat - { sumPatParens :: [AddApiAnn] + { sumPatParens :: [AddEpAnn] , sumPatVbarsBefore :: [AnnAnchor] , sumPatVbarsAfter :: [AnnAnchor] } deriving Data diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 59fcaf9fe1..5c49796b2f 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -151,7 +151,7 @@ type instance XHsForAllInvis (GhcPass _) = ApiAnnForallTy type instance XXHsForAllTelescope (GhcPass _) = NoExtCon -type ApiAnnForallTy = ApiAnn' (AddApiAnn, AddApiAnn) +type ApiAnnForallTy = ApiAnn' (AddEpAnn, AddEpAnn) -- ^ Location of 'forall' and '->' for HsForAllVis -- Location of 'forall' and '.' for HsForAllInvis @@ -474,15 +474,15 @@ mkHsAppKindTy ext ty k -- It returns API Annotations for any parens removed splitHsFunType :: LHsType (GhcPass p) - -> ( [AddApiAnn], ApiAnnComments -- The locations of any parens and - -- comments discarded + -> ( [AddEpAnn], ApiAnnComments -- The locations of any parens and + -- comments discarded , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p)) splitHsFunType ty = go ty where go (L l (HsParTy an ty)) = let (anns, cs, args, res) = splitHsFunType ty - anns' = anns ++ annParen2AddApiAnn an + anns' = anns ++ annParen2AddEpAnn an cs' = cs S.<> apiAnnComments (ann l) S.<> apiAnnComments an in (anns', cs', args, res) diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index b9bae7a1f7..79293b22cf 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -802,7 +802,7 @@ litpkgname_segment :: { Located FastString } -- Parse a minus sign regardless of whether -XLexicalNegation is turned on or off. -- See Note [Minus tokens] in GHC.Parser.Lexer -HYPHEN :: { [AddApiAnn] } +HYPHEN :: { [AddEpAnn] } : '-' { [mj AnnMinus $1 ] } | PREFIX_MINUS { [mj AnnMinus $1 ] } | VARSYM {% if (getVARSYM $1 == fsLit "-") @@ -980,7 +980,7 @@ maybeexports :: { (Maybe (LocatedL [LIE GhcPs])) } (AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) []) } | {- empty -} { Nothing } -exportlist :: { ([AddApiAnn], OrdList (LIE GhcPs)) } +exportlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) } : exportlist1 { ([], $1) } | {- empty -} { ([], nilOL) } @@ -1012,17 +1012,17 @@ export :: { OrdList (LIE GhcPs) } | 'pattern' qcon { unitOL (reLocA (sLL $1 (reLocN $>) (IEVar noExtField (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2))))) } -export_subspec :: { Located ([AddApiAnn],ImpExpSubSpec) } +export_subspec :: { Located ([AddEpAnn],ImpExpSubSpec) } : {- empty -} { sL0 ([],ImpExpAbs) } | '(' qcnames ')' {% mkImpExpSubSpec (reverse (snd $2)) >>= \(as,ie) -> return $ sLL $1 $> (as ++ [mop $1,mcp $3] ++ fst $2, ie) } -qcnames :: { ([AddApiAnn], [LocatedA ImpExpQcSpec]) } +qcnames :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } : {- empty -} { ([],[]) } | qcnames1 { $1 } -qcnames1 :: { ([AddApiAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list +qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list : qcnames1 ',' qcname_ext_w_wildcard {% case (snd $1) of (l@(L la ImpExpQcWildcard):t) -> do { l' <- addTrailingCommaA l (gl $2) @@ -1039,7 +1039,7 @@ qcnames1 :: { ([AddApiAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor -qcname_ext_w_wildcard :: { Located ([AddApiAnn], LocatedA ImpExpQcSpec) } +qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } : qcname_ext { sL1A $1 ([],$1) } | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } @@ -1366,7 +1366,7 @@ deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } -- Injective type families -opt_injective_info :: { Located ([AddApiAnn], Maybe (LInjectivityAnn GhcPs)) } +opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) } : {- empty -} { noLoc ([], Nothing) } | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1] , Just ($2)) } @@ -1381,13 +1381,13 @@ inj_varids :: { Located [LocatedN RdrName] } -- Closed type families -where_type_family :: { Located ([AddApiAnn],FamilyInfo GhcPs) } +where_type_family :: { Located ([AddEpAnn],FamilyInfo GhcPs) } : {- empty -} { noLoc ([],OpenTypeFamily) } | 'where' ty_fam_inst_eqn_list { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2) ,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) } -ty_fam_inst_eqn_list :: { Located ([AddApiAnn],Maybe [LTyFamInstEqn GhcPs]) } +ty_fam_inst_eqn_list :: { Located ([AddEpAnn],Maybe [LTyFamInstEqn GhcPs]) } : '{' ty_fam_inst_eqns '}' { sLL $1 $> ([moc $1,mcc $3] ,Just (unLoc $2)) } | vocurly ty_fam_inst_eqns close { let (L loc _) = $2 in @@ -1464,11 +1464,11 @@ at_decl_cls :: { LHsDecl GhcPs } {% liftM mkInstD (mkTyFamInst (comb2A $1 $3) (unLoc $3) (mj AnnType $1:mj AnnInstance $2:[]) )} -opt_family :: { [AddApiAnn] } +opt_family :: { [AddEpAnn] } : {- empty -} { [] } | 'family' { [mj AnnFamily $1] } -opt_instance :: { [AddApiAnn] } +opt_instance :: { [AddEpAnn] } : {- empty -} { [] } | 'instance' { [mj AnnInstance $1] } @@ -1498,27 +1498,27 @@ at_decl_inst :: { LInstDecl GhcPs } (fmap reverse $7) ((fst $ unLoc $1):$2++(fst $ unLoc $5)++(fst $ unLoc $6)) } -data_or_newtype :: { Located (AddApiAnn, NewOrData) } +data_or_newtype :: { Located (AddEpAnn, NewOrData) } : 'data' { sL1 $1 (mj AnnData $1,DataType) } | 'newtype' { sL1 $1 (mj AnnNewtype $1,NewType) } -- Family result/return kind signatures -opt_kind_sig :: { Located ([AddApiAnn], Maybe (LHsKind GhcPs)) } +opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } : { noLoc ([] , Nothing) } | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], Just $2) } -opt_datafam_kind_sig :: { Located ([AddApiAnn], LFamilyResultSig GhcPs) } +opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLoc (NoSig noExtField) )} | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLL $1 (reLoc $>) (KindSig noExtField $2))} -opt_tyfam_kind_sig :: { Located ([AddApiAnn], LFamilyResultSig GhcPs) } +opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLoc (NoSig noExtField) )} | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLL $1 (reLoc $>) (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1], sLL $1 (reLoc $>) (TyVarSig noExtField tvb))} } -opt_at_kind_inj_sig :: { Located ([AddApiAnn], ( LFamilyResultSig GhcPs +opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLoc (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 (reLoc $>) ( [mu AnnDcolon $1] @@ -1625,7 +1625,7 @@ pattern_synonym_decl :: { LHsDecl GhcPs } (ApiAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }} -pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs, [AddApiAnn]) } +pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs, [AddEpAnn]) } : con vars0 { ($1, PrefixCon noTypeArgs $2, []) } | varid conop varid { ($2, InfixCon $1 $3, []) } | con '{' cvars1 '}' { ($1, RecCon $3, [moc $2, mcc $4] ) } @@ -1672,7 +1672,7 @@ decl_cls : at_decl_cls { $1 } quotes (ppr $2) ; acsA (\cs -> sLL $1 (reLoc $>) $ SigD noExtField $ ClassOpSig (ApiAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} -decls_cls :: { Located ([AddApiAnn],OrdList (LHsDecl GhcPs)) } -- Reversed +decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) then return (sLLlA $1 $> ((mz AnnSemi $2) ++ (fst $ unLoc $1) , unitOL $3)) @@ -1693,7 +1693,7 @@ decls_cls :: { Located ([AddApiAnn],OrdList (LHsDecl GhcPs)) } -- Reversed | {- empty -} { noLoc ([],nilOL) } decllist_cls - :: { Located ([AddApiAnn] + :: { Located ([AddEpAnn] , OrdList (LHsDecl GhcPs) , LayoutInfo) } -- Reversed : '{' decls_cls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2) @@ -1703,7 +1703,7 @@ decllist_cls -- Class body -- -where_cls :: { Located ([AddApiAnn] +where_cls :: { Located ([AddEpAnn] ,(OrdList (LHsDecl GhcPs)) -- Reversed ,LayoutInfo) } -- No implicit parameters @@ -1718,7 +1718,7 @@ decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } | decl { sL1A $1 (unitOL $1) } -decls_inst :: { Located ([AddApiAnn],OrdList (LHsDecl GhcPs)) } -- Reversed +decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> ((mz AnnSemi $2) ++ (fst $ unLoc $1) , unLoc $3)) @@ -1739,14 +1739,14 @@ decls_inst :: { Located ([AddApiAnn],OrdList (LHsDecl GhcPs)) } -- Reversed | {- empty -} { noLoc ([],nilOL) } decllist_inst - :: { Located ([AddApiAnn] + :: { Located ([AddEpAnn] , OrdList (LHsDecl GhcPs)) } -- Reversed : '{' decls_inst '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2),snd $ unLoc $2) } | vocurly decls_inst close { L (gl $2) (unLoc $2) } -- Instance body -- -where_inst :: { Located ([AddApiAnn] +where_inst :: { Located ([AddEpAnn] , OrdList (LHsDecl GhcPs)) } -- Reversed -- No implicit parameters -- May have type declarations @@ -1838,7 +1838,7 @@ rule :: { LRuleDecl GhcPs } , rd_lhs = $4, rd_rhs = $6 })) } -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas -rule_activation :: { ([AddApiAnn],Maybe Activation) } +rule_activation :: { ([AddEpAnn],Maybe Activation) } -- See Note [%shift: rule_activation -> {- empty -}] : {- empty -} %shift { ([],Nothing) } | rule_explicit_activation { (fst $1,Just (snd $1)) } @@ -1851,14 +1851,14 @@ rule_activation :: { ([AddApiAnn],Maybe Activation) } -- without a space [~1] (the PREFIX_TILDE case), or -- with a space [~ 1] (the VARSYM case). -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer -rule_activation_marker :: { [AddApiAnn] } +rule_activation_marker :: { [AddEpAnn] } : PREFIX_TILDE { [mj AnnTilde $1] } | VARSYM {% if (getVARSYM $1 == fsLit "~") then return [mj AnnTilde $1] else do { addError $ PsError PsErrInvalidRuleActivationMarker [] (getLoc $1) ; return [] } } -rule_explicit_activation :: { ([AddApiAnn] +rule_explicit_activation :: { ([AddEpAnn] ,Activation) } -- In brackets : '[' INTEGER ']' { ([mos $1,mj AnnVal $2,mcs $3] ,ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) } @@ -1869,7 +1869,7 @@ rule_explicit_activation :: { ([AddApiAnn] { ($2++[mos $1,mcs $3] ,NeverActive) } -rule_foralls :: { ([AddApiAnn] -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) } +rule_foralls :: { ([AddEpAnn] -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) } : 'forall' rule_vars '.' 'forall' rule_vars '.' {% let tyvs = mkRuleTyVarBndrs $2 in hintExplicitForall $1 >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs $2) @@ -1965,7 +1965,7 @@ deprecation :: { OrdList (LWarnDecl GhcPs) } {% fmap unitOL $ acsA (\cs -> sLL $1 $> $ (Warning (ApiAnn (glR $1) (fst $ unLoc $2) cs) (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2))) } -strings :: { Located ([AddApiAnn],[Located StringLiteral]) } +strings :: { Located ([AddEpAnn],[Located StringLiteral]) } : STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) } | '[' stringlist ']' { sLL $1 $> $ ([mos $1,mcs $3],fromOL (unLoc $2)) } @@ -2007,7 +2007,7 @@ annotation :: { LHsDecl GhcPs } ----------------------------------------------------------------------------- -- Foreign import and export declarations -fdecl :: { Located ([AddApiAnn],ApiAnn -> HsDecl GhcPs) } +fdecl :: { Located ([AddEpAnn],ApiAnn -> HsDecl GhcPs) } fdecl : 'import' callconv safety fspec {% mkImport $2 $3 (snd $ unLoc $4) >>= \i -> return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i)) } @@ -2030,7 +2030,7 @@ safety :: { Located Safety } | 'safe' { sLL $1 $> PlaySafe } | 'interruptible' { sLL $1 $> PlayInterruptible } -fspec :: { Located ([AddApiAnn] +fspec :: { Located ([AddEpAnn] ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) } : STRING var '::' sigtype { sLL $1 (reLoc $>) ([mu AnnDcolon $3] ,(L (getLoc $1) @@ -2044,11 +2044,11 @@ fspec :: { Located ([AddApiAnn] ----------------------------------------------------------------------------- -- Type signatures -opt_sig :: { Maybe (AddApiAnn, LHsType GhcPs) } +opt_sig :: { Maybe (AddEpAnn, LHsType GhcPs) } : {- empty -} { Nothing } | '::' ctype { Just (mu AnnDcolon $1, $2) } -opt_tyconsig :: { ([AddApiAnn], Maybe (LocatedN RdrName)) } +opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } : {- empty -} { ([], Nothing) } | '::' gtycon { ([mu AnnDcolon $1], Just $2) } @@ -2279,7 +2279,7 @@ tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (ApiAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (ApiAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } -fds :: { Located ([AddApiAnn],[LHsFunDep GhcPs]) } +fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } : {- empty -} { noLoc ([],[]) } | '|' fds1 { (sLL $1 $> ([mj AnnVbar $1] ,reverse (unLoc $2))) } @@ -2332,7 +2332,7 @@ And both become a HsTyVar ("Zero", DataName) after the renamer. ----------------------------------------------------------------------------- -- Datatype declarations -gadt_constrlist :: { Located ([AddApiAnn] +gadt_constrlist :: { Located ([AddEpAnn] ,[LConDecl GhcPs]) } -- Returned in order : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $ @@ -2379,7 +2379,7 @@ consequence, GADT constructor names are restricted (names like '(*)' are allowed in usual data constructors, but not in GADTs). -} -constrs :: { Located ([AddApiAnn],[LConDecl GhcPs]) } +constrs :: { Located ([AddEpAnn],[LConDecl GhcPs]) } : '=' constrs1 { sLL $1 $2 ([mj AnnEqual $1],unLoc $2)} constrs1 :: { Located [LConDecl GhcPs] } @@ -2407,7 +2407,7 @@ constr :: { LConDecl GhcPs } Nothing -- No context details))) } -forall :: { Located ([AddApiAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) } +forall :: { Located ([AddEpAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) } : 'forall' tv_bndrs '.' { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) } | {- empty -} { noLoc ([], Nothing) } @@ -2592,12 +2592,12 @@ sigdecl :: { LHsDecl GhcPs } | '{-# MINIMAL' name_boolformula_opt '#-}' {% acsA (\cs -> sLL $1 $> $ SigD noExtField (MinimalSig (ApiAnn (glR $1) [mo $1,mc $3] cs) (getMINIMAL_PRAGs $1) $2)) } -activation :: { ([AddApiAnn],Maybe Activation) } +activation :: { ([AddEpAnn],Maybe Activation) } -- See Note [%shift: activation -> {- empty -}] : {- empty -} %shift { ([],Nothing) } | explicit_activation { (fst $1,Just (snd $1)) } -explicit_activation :: { ([AddApiAnn],Activation) } -- In brackets +explicit_activation :: { ([AddEpAnn],Activation) } -- In brackets : '[' INTEGER ']' { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3] ,ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) } | '[' rule_activation_marker INTEGER ']' @@ -2965,7 +2965,7 @@ acmd :: { LHsCmdTop GhcPs } runPV (checkCmdBlockArguments cmd) >>= \ _ -> return (sL1A cmd $ HsCmdTop noExtField cmd) } -cvtopbody :: { ([AddApiAnn],[LHsDecl GhcPs]) } +cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 ,mj AnnCloseC $3],$2) } | vocurly cvtopdecls0 close { ([],$2) } @@ -3058,7 +3058,7 @@ tup_tail :: { forall b. DisambECP b => PV [Either (ApiAnn' AnnAnchor) (LocatedA -- The rules below are little bit contorted to keep lexps left-recursive while -- avoiding another shift/reduce-conflict. -- Never empty. -list :: { forall b. DisambECP b => SrcSpan -> (AddApiAnn, AddApiAnn) -> PV (LocatedA b) } +list :: { forall b. DisambECP b => SrcSpan -> (AddEpAnn, AddEpAnn) -> PV (LocatedA b) } : texp { \loc (ao,ac) -> unECP $1 >>= \ $1 -> mkHsExplicitListPV loc [$1] (AnnList Nothing (Just ao) (Just ac) [] []) } | lexps { \loc (ao,ac) -> $1 >>= \ $1 -> @@ -3202,14 +3202,14 @@ altslist :: { forall b. DisambECP b => PV (LocatedL [LMatch GhcPs (LocatedA b)]) | '{' '}' { amsrl (sLL $1 $> []) (AnnList Nothing (Just $ moc $1) (Just $ mcc $2) [] []) } | vocurly close { return $ noLocA [] } -alts :: { forall b. DisambECP b => PV (Located ([AddApiAnn],[LMatch GhcPs (LocatedA b)])) } +alts :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (LocatedA b)])) } : alts1 { $1 >>= \ $1 -> return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { $2 >>= \ $2 -> return $ sLL $1 $> (((mz AnnSemi $1) ++ (fst $ unLoc $2)) ,snd $ unLoc $2) } -alts1 :: { forall b. DisambECP b => PV (Located ([AddApiAnn],[LMatch GhcPs (LocatedA b)])) } +alts1 :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (LocatedA b)])) } : alts1 ';' alt { $1 >>= \ $1 -> $3 >>= \ $3 -> case snd $ unLoc $1 of @@ -3254,7 +3254,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and -- we don't need it. -ifgdpats :: { Located ([AddApiAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } +ifgdpats :: { Located ([AddEpAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } : '{' gdpats '}' {% runPV $2 >>= \ $2 -> return $ sLL $1 $> ([moc $1,mcc $3],unLoc $2) } | gdpats close {% runPV $1 >>= \ $1 -> @@ -4145,27 +4145,27 @@ in GHC.Parser.Annotation -} --- |Construct an AddApiAnn from the annotation keyword and the location +-- |Construct an AddEpAnn from the annotation keyword and the location -- of the keyword itself -mj :: AnnKeywordId -> Located e -> AddApiAnn -mj a l = AddApiAnn a (AR $ rs $ gl l) +mj :: AnnKeywordId -> Located e -> AddEpAnn +mj a l = AddEpAnn a (AR $ rs $ gl l) -mjN :: AnnKeywordId -> LocatedN e -> AddApiAnn -mjN a l = AddApiAnn a (AR $ rs $ glN l) +mjN :: AnnKeywordId -> LocatedN e -> AddEpAnn +mjN a l = AddEpAnn a (AR $ rs $ glN l) --- |Construct an AddApiAnn from the annotation keyword and the location +-- |Construct an AddEpAnn from the annotation keyword and the location -- of the keyword itself, provided the span is not zero width -mz :: AnnKeywordId -> Located e -> [AddApiAnn] -mz a l = if isZeroWidthSpan (gl l) then [] else [AddApiAnn a (AR $ rs $ gl l)] +mz :: AnnKeywordId -> Located e -> [AddEpAnn] +mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (AR $ rs $ gl l)] msemi :: Located e -> [TrailingAnn] msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (AR $ rs $ gl l)] --- |Construct an AddApiAnn from the annotation keyword and the Located Token. If +-- |Construct an AddEpAnn from the annotation keyword and the Located Token. If -- the token has a unicode equivalent and this has been used, provide the -- unicode variant of the annotation. -mu :: AnnKeywordId -> Located Token -> AddApiAnn -mu a lt@(L l t) = AddApiAnn (toUnicodeAnn a lt) (AR $ rs l) +mu :: AnnKeywordId -> Located Token -> AddEpAnn +mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (AR $ rs l) mau :: Located Token -> TrailingAnn mau lt@(L l t) = if isUnicode lt then AddRarrowAnnU (AR $ rs l) @@ -4266,24 +4266,24 @@ amsrn (L l a) an = do let ann = (ApiAnn (spanAsAnchor l) an cs) return (L (SrcSpanAnn ann l) a) --- |Synonyms for AddApiAnn versions of AnnOpen and AnnClose -mo,mc :: Located Token -> AddApiAnn +-- |Synonyms for AddEpAnn versions of AnnOpen and AnnClose +mo,mc :: Located Token -> AddEpAnn mo ll = mj AnnOpen ll mc ll = mj AnnClose ll -moc,mcc :: Located Token -> AddApiAnn +moc,mcc :: Located Token -> AddEpAnn moc ll = mj AnnOpenC ll mcc ll = mj AnnCloseC ll -mop,mcp :: Located Token -> AddApiAnn +mop,mcp :: Located Token -> AddEpAnn mop ll = mj AnnOpenP ll mcp ll = mj AnnCloseP ll -moh,mch :: Located Token -> AddApiAnn +moh,mch :: Located Token -> AddEpAnn moh ll = mj AnnOpenPH ll mch ll = mj AnnClosePH ll -mos,mcs :: Located Token -> AddApiAnn +mos,mcs :: Located Token -> AddEpAnn mos ll = mj AnnOpenS ll mcs ll = mj AnnCloseS ll @@ -4328,7 +4328,7 @@ 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 [AddApiAnn kw (AR $ rs l)] [] + = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (AR $ rs l)] [] listAsAnchor :: [LocatedAn t a] -> Anchor listAsAnchor [] = spanAsAnchor noSrcSpan diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index bbb819f82c..fe769a2783 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -12,7 +12,7 @@ module GHC.Parser.Annotation ( HasE(..), -- * In-tree Api Annotations - AddApiAnn(..), + AddEpAnn(..), AnnAnchor(..), annAnchorRealSrcSpan, DeltaPos(..), @@ -58,7 +58,7 @@ module GHC.Parser.Annotation ( -- ** Querying annotations getLocAnn, apiAnnAnns, apiAnnAnnsL, - annParen2AddApiAnn, + annParen2AddEpAnn, apiAnnComments, -- ** Working with locations of annotations @@ -383,10 +383,10 @@ data HasE = HasE | NoE -- source file. -- The @'AnnAnchor'@ can also store a delta position if the AST has been -- modified and needs to be pretty printed again. --- The usual way an 'AddApiAnn' is created is using the 'mj' ("make +-- The usual way an 'AddEpAnn' is created is using the 'mj' ("make -- jump") function, and then it can be inserted into the appropriate -- annotation. -data AddApiAnn = AddApiAnn AnnKeywordId AnnAnchor deriving (Data,Show,Eq,Ord) +data AddEpAnn = AddEpAnn AnnKeywordId AnnAnchor deriving (Data,Show,Eq,Ord) -- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'AR'@ -- variant, giving the exact location of the original item in the @@ -419,8 +419,8 @@ instance Outputable AnnAnchor where ppr (AR r) = text "AR" <+> ppr r ppr (AD d) = text "AD" <+> ppr d -instance Outputable AddApiAnn where - ppr (AddApiAnn kw ss) = text "AddApiAnn" <+> ppr kw <+> ppr ss +instance Outputable AddEpAnn where + ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss -- --------------------------------------------------------------------- @@ -555,9 +555,9 @@ com cs = AnnComments cs -- | This type is the most direct mapping of the previous API -- Annotations model. It captures the containing `SrcSpan' in its --- `entry` `Anchor`, has a list of `AddApiAnn` as before, and keeps +-- `entry` `Anchor`, has a list of `AddEpAnn` as before, and keeps -- track of the comments associated with the anchor. -type ApiAnn = ApiAnn' [AddApiAnn] +type ApiAnn = ApiAnn' [AddEpAnn] -- --------------------------------------------------------------------- -- Annotations attached to a 'SrcSpan'. @@ -671,9 +671,9 @@ data AnnList -- TODO:AZ: should we distinguish AnnList variants for lists -- with layout and without? al_anchor :: Maybe Anchor, -- ^ start point of a list having layout - al_open :: Maybe AddApiAnn, - al_close :: Maybe AddApiAnn, - al_rest :: [AddApiAnn], -- ^ context, such as 'where' keyword + al_open :: Maybe AddEpAnn, + al_close :: Maybe AddEpAnn, + al_rest :: [AddEpAnn], -- ^ context, such as 'where' keyword al_trailing :: [TrailingAnn] } deriving (Data,Eq) @@ -782,9 +782,9 @@ data NameAdornment -- pragmas. data AnnPragma = AnnPragma { - apr_open :: AddApiAnn, - apr_close :: AddApiAnn, - apr_rest :: [AddApiAnn] + apr_open :: AddEpAnn, + apr_close :: AddEpAnn, + apr_rest :: [AddEpAnn] } deriving (Data,Eq) -- --------------------------------------------------------------------- @@ -889,7 +889,7 @@ realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary la2r :: SrcSpanAnn' a -> RealSrcSpan la2r l = realSrcSpan (locA l) -extraToAnnList :: AnnList -> [AddApiAnn] -> AnnList +extraToAnnList :: AnnList -> [AddEpAnn] -> AnnList extraToAnnList (AnnList a o c e t) as = AnnList a o c (e++as) t reAnn :: [TrailingAnn] -> ApiAnnComments -> Located a -> LocatedA a @@ -922,7 +922,7 @@ noAnn :: ApiAnn' a noAnn = ApiAnnNotUsed -addAnns :: ApiAnn -> [AddApiAnn] -> ApiAnnComments -> ApiAnn +addAnns :: ApiAnn -> [AddEpAnn] -> ApiAnnComments -> ApiAnn addAnns (ApiAnn l as1 cs) as2 cs2 = ApiAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2) addAnns ApiAnnNotUsed [] (AnnComments []) = ApiAnnNotUsed @@ -942,43 +942,43 @@ addAnnsA (SrcSpanAnn ApiAnnNotUsed loc) as cs -- | The annotations need to all come after the anchor. Make sure -- this is the case. -widenSpan :: SrcSpan -> [AddApiAnn] -> SrcSpan +widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan widenSpan s as = foldl combineSrcSpans s (go as) where go [] = [] - go (AddApiAnn _ (AR s):rest) = RealSrcSpan s Nothing : go rest - go (AddApiAnn _ (AD _):rest) = go rest + go (AddEpAnn _ (AR s):rest) = RealSrcSpan s Nothing : go rest + go (AddEpAnn _ (AD _):rest) = go rest -- | The annotations need to all come after the anchor. Make sure -- this is the case. -widenRealSpan :: RealSrcSpan -> [AddApiAnn] -> RealSrcSpan +widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan widenRealSpan s as = foldl combineRealSrcSpans s (go as) where go [] = [] - go (AddApiAnn _ (AR s):rest) = s : go rest - go (AddApiAnn _ (AD _):rest) = go rest + go (AddEpAnn _ (AR s):rest) = s : go rest + go (AddEpAnn _ (AD _):rest) = go rest -widenAnchor :: Anchor -> [AddApiAnn] -> Anchor +widenAnchor :: Anchor -> [AddEpAnn] -> Anchor widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op widenAnchorR :: Anchor -> RealSrcSpan -> Anchor widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op -widenLocatedAn :: SrcSpanAnn' an -> [AddApiAnn] -> SrcSpanAnn' an +widenLocatedAn :: SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as) apiAnnAnnsL :: ApiAnn' a -> [a] apiAnnAnnsL ApiAnnNotUsed = [] apiAnnAnnsL (ApiAnn _ anns _) = [anns] -apiAnnAnns :: ApiAnn -> [AddApiAnn] +apiAnnAnns :: ApiAnn -> [AddEpAnn] apiAnnAnns ApiAnnNotUsed = [] apiAnnAnns (ApiAnn _ anns _) = anns -annParen2AddApiAnn :: ApiAnn' AnnParen -> [AddApiAnn] -annParen2AddApiAnn ApiAnnNotUsed = [] -annParen2AddApiAnn (ApiAnn _ (AnnParen pt o c) _) - = [AddApiAnn ai o, AddApiAnn ac c] +annParen2AddEpAnn :: ApiAnn' AnnParen -> [AddEpAnn] +annParen2AddEpAnn ApiAnnNotUsed = [] +annParen2AddEpAnn (ApiAnn _ (AnnParen pt o c) _) + = [AddEpAnn ai o, AddEpAnn ac c] where (ai,ac) = parenTypeKws pt diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index 634cd10207..8eea1aea62 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -3435,11 +3435,11 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag)) -- |Given a 'SrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate --- 'AddApiAnn' values for the opening and closing bordering on the start +-- 'AddEpAnn' values for the opening and closing bordering on the start -- and end of the span -mkParensApiAnn :: SrcSpan -> [AddApiAnn] +mkParensApiAnn :: SrcSpan -> [AddEpAnn] mkParensApiAnn (UnhelpfulSpan _) = [] -mkParensApiAnn (RealSrcSpan ss _) = [AddApiAnn AnnOpenP (AR lo),AddApiAnn AnnCloseP (AR lc)] +mkParensApiAnn (RealSrcSpan ss _) = [AddEpAnn AnnOpenP (AR lo),AddEpAnn AnnCloseP (AR lc)] where f = srcSpanFile ss sl = srcSpanStartLine ss diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 87de59b7e0..56564ef908 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -180,7 +180,7 @@ mkClassDecl :: SrcSpan -> Located (a,[LHsFunDep GhcPs]) -> OrdList (LHsDecl GhcPs) -> LayoutInfo - -> [AddApiAnn] + -> [AddEpAnn] -> P (LTyClDecl GhcPs) mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn @@ -207,7 +207,7 @@ mkTyData :: SrcSpan -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) - -> [AddApiAnn] + -> [AddEpAnn] -> P (LTyClDecl GhcPs) mkTyData loc' new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons (L _ maybe_deriv) annsIn @@ -243,7 +243,7 @@ mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv ann mkTySynonym :: SrcSpan -> LHsType GhcPs -- LHS -> LHsType GhcPs -- RHS - -> [AddApiAnn] + -> [AddEpAnn] -> P (LTyClDecl GhcPs) mkTySynonym loc lhs rhs annsIn = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs @@ -261,7 +261,7 @@ mkStandaloneKindSig :: SrcSpan -> Located [LocatedN RdrName] -- LHS -> LHsSigType GhcPs -- RHS - -> [AddApiAnn] + -> [AddEpAnn] -> P (LStandaloneKindSig GhcPs) mkStandaloneKindSig loc lhs rhs anns = do { vs <- mapM check_lhs_name (unLoc lhs) @@ -284,7 +284,7 @@ mkTyFamInstEqn :: SrcSpan -> HsOuterFamEqnTyVarBndrs GhcPs -> LHsType GhcPs -> LHsType GhcPs - -> [AddApiAnn] + -> [AddEpAnn] -> P (LTyFamInstEqn GhcPs) mkTyFamInstEqn loc bndrs lhs rhs anns = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs @@ -305,7 +305,7 @@ mkDataFamInst :: SrcSpan -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> Located (HsDeriving GhcPs) - -> [AddApiAnn] + -> [AddEpAnn] -> P (LInstDecl GhcPs) mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) ksig data_cons (L _ maybe_deriv) anns @@ -324,7 +324,7 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs - -> [AddApiAnn] + -> [AddEpAnn] -> P (LInstDecl GhcPs) mkTyFamInst loc eqn anns = do cs <- getCommentsFor loc @@ -337,7 +337,7 @@ mkFamDecl :: SrcSpan -> LHsType GhcPs -- LHS -> Located (FamilyResultSig GhcPs) -- Optional result signature -> Maybe (LInjectivityAnn GhcPs) -- Injectivity annotation - -> [AddApiAnn] + -> [AddEpAnn] -> P (LTyClDecl GhcPs) mkFamDecl loc info topLevel lhs ksig injAnn annsIn = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs @@ -388,7 +388,7 @@ mkSpliceDecl lexpr@(L loc expr) mkRoleAnnotDecl :: SrcSpan -> LocatedN RdrName -- type being annotated -> [Located (Maybe FastString)] -- roles - -> [AddApiAnn] + -> [AddEpAnn] -> P (LRoleAnnotDecl GhcPs) mkRoleAnnotDecl loc tycon roles anns = do { roles' <- mapM parse_role roles @@ -431,21 +431,21 @@ fromSpecTyVarBndr bndr = case bndr of check_spec InferredSpec loc = addFatalError $ PsError PsErrInferredTypeVarNotAllowed [] (locA loc) -- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@ -annBinds :: AddApiAnn -> HsLocalBinds GhcPs -> HsLocalBinds GhcPs +annBinds :: AddEpAnn -> HsLocalBinds GhcPs -> HsLocalBinds GhcPs annBinds a (HsValBinds an bs) = (HsValBinds (add_where a an) bs) annBinds a (HsIPBinds an bs) = (HsIPBinds (add_where a an) bs) annBinds _ (EmptyLocalBinds x) = (EmptyLocalBinds x) -add_where :: AddApiAnn -> ApiAnn' AnnList -> ApiAnn' AnnList -add_where an@(AddApiAnn _ (AR rs)) (ApiAnn a (AnnList anc o c r t) cs) +add_where :: AddEpAnn -> ApiAnn' AnnList -> ApiAnn' AnnList +add_where an@(AddEpAnn _ (AR rs)) (ApiAnn a (AnnList anc o c r t) cs) | valid_anchor (anchor a) = ApiAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) cs | otherwise = ApiAnn (patch_anchor rs a) (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) cs -add_where an@(AddApiAnn _ (AR rs)) ApiAnnNotUsed +add_where an@(AddEpAnn _ (AR rs)) ApiAnnNotUsed = ApiAnn (Anchor rs UnchangedAnchor) (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) noCom -add_where (AddApiAnn _ (AD _)) _ = panic "add_where" +add_where (AddEpAnn _ (AD _)) _ = panic "add_where" -- AD should only be used for transformations valid_anchor :: RealSrcSpan -> Bool @@ -702,7 +702,7 @@ mkConDeclH98 ann name mb_forall mb_cxt args mkGadtDecl :: SrcSpan -> [LocatedN RdrName] -> LHsSigType GhcPs - -> [AddApiAnn] + -> [AddEpAnn] -> P (LConDecl GhcPs) mkGadtDecl loc names ty annsIn = do cs <- getCommentsFor loc @@ -825,20 +825,19 @@ eitherToP (Right thing) = return thing checkTyVars :: SDoc -> SDoc -> LocatedN RdrName -> [LHsTypeArg GhcPs] -> P ( LHsQTyVars GhcPs -- the synthesized type variables - , [AddApiAnn] ) -- action which adds annotations + , [AddEpAnn] ) -- action which adds annotations -- ^ Check whether the given list of type parameters are all type variables -- (possibly with a kind signature). checkTyVars pp_what equals_or_where tc tparms = do { (tvs, anns) <- fmap unzip $ mapM check tparms ; return (mkHsQTvs tvs, concat anns) } where - check :: HsArg (LHsType GhcPs) (LHsType GhcPs) -> P (LHsTyVarBndr () GhcPs, [AddApiAnn]) -- AZ check (HsTypeArg _ ki@(L loc _)) = addFatalError $ PsError (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] (locA loc) check (HsValArg ty) = chkParens [] noCom ty check (HsArgPar sp) = addFatalError $ PsError (PsErrMalformedDecl pp_what (unLoc tc)) [] sp -- Keep around an action for adjusting the annotations of extra parens - chkParens :: [AddApiAnn] -> ApiAnnComments -> LHsType GhcPs - -> P (LHsTyVarBndr () GhcPs, [AddApiAnn]) + chkParens :: [AddEpAnn] -> ApiAnnComments -> LHsType GhcPs + -> P (LHsTyVarBndr () GhcPs, [AddEpAnn]) chkParens acc cs (L l (HsParTy an ty)) = chkParens (mkParensApiAnn (locA l) ++ acc) (cs Semi.<> apiAnnComments an) ty chkParens acc cs ty = do @@ -846,7 +845,7 @@ checkTyVars pp_what equals_or_where tc tparms return (tv, reverse acc) -- Check that the name space is correct! - chk :: [AddApiAnn] -> ApiAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs) + chk :: [AddEpAnn] -> ApiAnnComments -> LHsType GhcPs -> P (LHsTyVarBndr () GhcPs) chk an cs (L l (HsKindSig annk (L annt (HsTyVar ann _ (L lv tv))) k)) | isRdrTyVar tv = return (L (widenLocatedAn (l Semi.<> annt) an) @@ -908,8 +907,8 @@ checkRecordSyntax lr@(L loc r) -- | Check if the gadt_constrlist is empty. Only raise parse error for -- `data T where` to avoid affecting existing error message, see #8258. -checkEmptyGADTs :: Located ([AddApiAnn], [LConDecl GhcPs]) - -> P (Located ([AddApiAnn], [LConDecl GhcPs])) +checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs]) + -> P (Located ([AddEpAnn], [LConDecl GhcPs])) checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax unless gadtSyntax $ addError $ PsError PsErrIllegalWhereInDataDecl [] span @@ -922,7 +921,7 @@ checkTyClHdr :: Bool -- True <=> class header -> P (LocatedN RdrName, -- the head symbol (type or class name) [LHsTypeArg GhcPs], -- parameters of head symbol LexicalFixity, -- the declaration is in infix format - [AddApiAnn]) -- API Annotation for HsParTy + [AddEpAnn]) -- API Annotation for HsParTy -- when stripping parens -- Well-formedness check and decomposition of type and class heads. -- Decomposes T ty1 .. tyn into (T, [ty1, ..., tyn]) @@ -1147,7 +1146,7 @@ checkAPat loc e0 = do PatBuilderPar e an@(AnnParen pt o c) -> do (L l p) <- checkLPat e - let aa = [AddApiAnn ai o, AddApiAnn ac c] + let aa = [AddEpAnn ai o, AddEpAnn ac c] (ai,ac) = parenTypeKws pt return (ParPat (ApiAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an noCom) (L l p)) _ -> patFail (locA loc) (ppr e0) @@ -1178,7 +1177,7 @@ patIsRec e = e == mkUnqual varName (fsLit "rec") checkValDef :: SrcSpan -> LocatedA (PatBuilder GhcPs) - -> Maybe (AddApiAnn, LHsType GhcPs) + -> Maybe (AddEpAnn, LHsType GhcPs) -> Located (GRHSs GhcPs (LHsExpr GhcPs)) -> P (HsBind GhcPs) @@ -1200,7 +1199,7 @@ checkValDef loc lhs Nothing g@(L l grhss) checkFunBind :: SrcStrictness -> SrcSpan - -> [AddApiAnn] + -> [AddEpAnn] -> SrcSpan -> LocatedN RdrName -> LexicalFixity @@ -1237,7 +1236,7 @@ makeFunBind fn ms -- See Note [FunBind vs PatBind] checkPatBind :: SrcSpan - -> [AddApiAnn] + -> [AddEpAnn] -> LPat GhcPs -> Located (GRHSs GhcPs (LHsExpr GhcPs)) -> P (HsBind GhcPs) @@ -1283,7 +1282,7 @@ checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr isFunLhs :: LocatedA (PatBuilder GhcPs) -> P (Maybe (LocatedN RdrName, LexicalFixity, - [LocatedA (PatBuilder GhcPs)],[AddApiAnn])) + [LocatedA (PatBuilder GhcPs)],[AddEpAnn])) -- A variable binding is parsed as a FunBind. -- Just (fun, is_infix, arg_pats) if e is a function LHS isFunLhs e = go e [] [] @@ -1313,7 +1312,7 @@ mkBangTy anns strictness = -- | Result of parsing @{-\# UNPACK \#-}@ or @{-\# NOUNPACK \#-}@. data UnpackednessPragma = - UnpackednessPragma [AddApiAnn] SourceText SrcUnpackedness + UnpackednessPragma [AddEpAnn] SourceText SrcUnpackedness -- | Annotate a type with either an @{-\# UNPACK \#-}@ or a @{-\# NOUNPACK \#-}@ pragma. addUnpackednessP :: MonadP m => Located UnpackednessPragma -> LHsType GhcPs -> m (LHsType GhcPs) @@ -1416,7 +1415,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -- | Return an expression without ambiguity, or fail in a non-expression context. ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b) mkHsProjUpdatePV :: SrcSpan -> Located [Located (HsFieldLabel GhcPs)] - -> LocatedA b -> Bool -> [AddApiAnn] -> PV (LHsRecProj GhcPs (LocatedA b)) + -> LocatedA b -> Bool -> [AddEpAnn] -> PV (LHsRecProj GhcPs (LocatedA b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> (ApiAnnComments -> MatchGroup GhcPs (LocatedA b)) -> PV (LocatedA b) @@ -1436,7 +1435,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where mkHsCasePV :: SrcSpan -> LHsExpr GhcPs -> (LocatedL [LMatch GhcPs (LocatedA b)]) -> ApiAnnHsCase -> PV (LocatedA b) mkHsLamCasePV :: SrcSpan -> (LocatedL [LMatch GhcPs (LocatedA b)]) - -> [AddApiAnn] + -> [AddEpAnn] -> PV (LocatedA b) -- | Function argument representation type FunArg b @@ -1454,7 +1453,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> LocatedA b -> Bool -- semicolon? -> LocatedA b - -> [AddApiAnn] + -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "do { ... }" (do notation) mkHsDoPV :: @@ -1475,7 +1474,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where mkHsWildCardPV :: SrcSpan -> PV (Located b) -- | Disambiguate "a :: t" (type annotation) mkHsTySigPV - :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddApiAnn] -> PV (LocatedA b) + :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "[a,b,c]" (list syntax) mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b) -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices) @@ -1487,26 +1486,26 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where SrcSpan -> LocatedA b -> ([Fbind b], Maybe SrcSpan) -> - [AddApiAnn] -> + [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "-a" (negation) - mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddApiAnn] -> PV (LocatedA b) + mkHsNegAppPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "(# a)" (right operator section) mkHsSectionR_PV :: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (Located b) -- | Disambiguate "(a -> b)" (view pattern) mkHsViewPatPV - :: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddApiAnn] -> PV (LocatedA b) + :: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "a@b" (as-pattern) mkHsAsPatPV - :: SrcSpan -> LocatedN RdrName -> LocatedA b -> [AddApiAnn] -> PV (LocatedA b) + :: SrcSpan -> LocatedN RdrName -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "~a" (lazy pattern) - mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddApiAnn] -> PV (LocatedA b) + mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate "!a" (bang pattern) - mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddApiAnn] -> PV (LocatedA b) + mkHsBangPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b) -- | Disambiguate tuple sections and unboxed sums mkSumOrTuplePV - :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddApiAnn] -> PV (LocatedA b) + :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b) -- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas rejectPragmaPV :: LocatedA b -> PV () @@ -1989,13 +1988,13 @@ see Note [PatBuilder]). Consider the 'alts' production used to parse case-of alternatives: - alts :: { Located ([AddApiAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } + alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } : alts1 { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) } We abstract over LHsExpr GhcPs, and it becomes: - alts :: { forall b. DisambECP b => PV (Located ([AddApiAnn],[LMatch GhcPs (Located b)])) } + alts :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (Located b)])) } : alts1 { $1 >>= \ $1 -> return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { $2 >>= \ $2 -> @@ -2215,15 +2214,15 @@ However, there is a slight problem with this approach, namely code duplication in parser productions. Consider the 'alts' production used to parse case-of alternatives: - alts :: { Located ([AddApiAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } + alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } : alts1 { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) } Under the new scheme, we have to completely duplicate its type signature and each reduction rule: - alts :: { ( PV (Located ([AddApiAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression - , PV (Located ([AddApiAnn],[LMatch GhcPs (LHsCmd GhcPs)])) -- as a command + alts :: { ( PV (Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)])) -- as an expression + , PV (Located ([AddEpAnn],[LMatch GhcPs (LHsCmd GhcPs)])) -- as a command ) } : alts1 { ( checkExpOf2 $1 >>= \ $1 -> @@ -2259,13 +2258,13 @@ as a function from a GADT: Consider the 'alts' production used to parse case-of alternatives: - alts :: { Located ([AddApiAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } + alts :: { Located ([AddEpAnn],[LMatch GhcPs (LHsExpr GhcPs)]) } : alts1 { sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { sLL $1 $> ((mj AnnSemi $1:(fst $ unLoc $2)),snd $ unLoc $2) } We abstract over LHsExpr, and it becomes: - alts :: { forall b. ExpCmdG b -> PV (Located ([AddApiAnn],[LMatch GhcPs (Located (b GhcPs))])) } + alts :: { forall b. ExpCmdG b -> PV (Located ([AddEpAnn],[LMatch GhcPs (Located (b GhcPs))])) } : alts1 { \tag -> $1 tag >>= \ $1 -> return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } @@ -2289,7 +2288,7 @@ the scenes: And now the 'alts' production is simplified, as we no longer need to thread 'tag' explicitly: - alts :: { forall b. ExpCmdI b => PV (Located ([AddApiAnn],[LMatch GhcPs (Located (b GhcPs))])) } + alts :: { forall b. ExpCmdI b => PV (Located ([AddEpAnn],[LMatch GhcPs (Located (b GhcPs))])) } : alts1 { $1 >>= \ $1 -> return $ sL1 $1 (fst $ unLoc $1,snd $ unLoc $1) } | ';' alts { $2 >>= \ $2 -> @@ -2615,7 +2614,7 @@ data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName) | ImpExpQcType AnnAnchor (LocatedN RdrName) | ImpExpQcWildcard -mkModuleImpExp :: [AddApiAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs) +mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs) mkModuleImpExp anns (L l specname) subs = do cs <- getCommentsFor (locA l) -- AZ: IEVar can discard comments let ann = ApiAnn (spanAsAnchor $ locA l) anns cs @@ -2675,10 +2674,10 @@ checkImportSpec ie@(L _ specs) = addFatalError $ PsError PsErrIllegalImportBundleForm [] l -- In the correct order -mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddApiAnn], ImpExpSubSpec) +mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec) mkImpExpSubSpec [] = return ([], ImpExpList []) mkImpExpSubSpec [L la ImpExpQcWildcard] = - return ([AddApiAnn AnnDotdot (AR $ la2r la)], ImpExpAll) + return ([AddEpAnn AnnDotdot (AR $ la2r la)], ImpExpAll) mkImpExpSubSpec xs = if (any (isImpExpQcWildcard . unLoc) xs) then return $ ([], ImpExpAllWith xs) @@ -2878,7 +2877,7 @@ hintBangPat span e = do addError $ PsError (PsErrIllegalBangPattern e) [] span mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs) - -> [AddApiAnn] + -> [AddEpAnn] -> PV (LHsExpr GhcPs) -- Tuple @@ -2895,7 +2894,7 @@ mkSumOrTupleExpr l boxity (Tuple es) anns = do -- return $ L l (ExplicitSum noExtField alt arity e) mkSumOrTupleExpr l Unboxed (Sum alt arity e barsp barsa) anns = do let an = case anns of - [AddApiAnn AnnOpenPH o, AddApiAnn AnnClosePH c] -> + [AddEpAnn AnnOpenPH o, AddEpAnn AnnClosePH c] -> AnnExplicitSum o barsp barsa c _ -> panic "mkSumOrTupleExpr" cs <- getCommentsFor (locA l) @@ -2904,7 +2903,7 @@ mkSumOrTupleExpr l Boxed a@Sum{} _ = addFatalError $ PsError (PsErrUnsupportedBoxedSumExpr a) [] (locA l) mkSumOrTuplePat - :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddApiAnn] + :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> [AddEpAnn] -> PV (LocatedA (PatBuilder GhcPs)) -- Tuple @@ -2937,8 +2936,8 @@ mkLHsOpTy x op y = mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs mkMultTy u tok t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) -- See #18888 for the use of (SourceText "1") above - = HsLinearArrow u (Just $ AddApiAnn AnnPercentOne (AR $ realSrcSpan $ combineLocs tok (reLoc t))) -mkMultTy u tok t = HsExplicitMult u (Just $ AddApiAnn AnnPercent (AR $ realSrcSpan $ getLoc tok)) t + = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (AR $ realSrcSpan $ combineLocs tok (reLoc t))) +mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (AR $ realSrcSpan $ getLoc tok)) t ----------------------------------------------------------------------------- -- Token symbols diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs index d91a2f3267..4263f9548c 100644 --- a/compiler/Language/Haskell/Syntax/Type.hs +++ b/compiler/Language/Haskell/Syntax/Type.hs @@ -915,9 +915,9 @@ data HsTyLit data HsArrow pass = HsUnrestrictedArrow IsUnicodeSyntax -- ^ a -> b or a → b - | HsLinearArrow IsUnicodeSyntax (Maybe AddApiAnn) + | HsLinearArrow IsUnicodeSyntax (Maybe AddEpAnn) -- ^ a %1 -> b or a %1 → b, or a ⊸ b - | HsExplicitMult IsUnicodeSyntax (Maybe AddApiAnn) (LHsType pass) + | HsExplicitMult IsUnicodeSyntax (Maybe AddEpAnn) (LHsType pass) -- ^ a %m -> b or a %m → b (very much including `a %Many -> b`! -- This is how the programmer wrote it). It is stored as an -- `HsType` so as to preserve the syntax as written in the |