summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
authorTakenobu Tani <takenobu.hs@gmail.com>2020-06-06 12:07:42 +0900
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-25 03:54:44 -0400
commitc7dd6da7e066872a949be7c914cc700182307cd2 (patch)
treeceae3a095d12be2c44e6e9794277d3e3a5329fc9 /compiler/GHC/Hs
parent90f438724dbc1ef9e4b371034d44170738fe3224 (diff)
downloadhaskell-c7dd6da7e066872a949be7c914cc700182307cd2.tar.gz
Clean up haddock hyperlinks of GHC.* (part1)
This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Binds.hs86
-rw-r--r--compiler/GHC/Hs/Decls.hs168
-rw-r--r--compiler/GHC/Hs/Expr.hs204
-rw-r--r--compiler/GHC/Hs/ImpExp.hs46
-rw-r--r--compiler/GHC/Hs/Lit.hs2
-rw-r--r--compiler/GHC/Hs/Pat.hs40
-rw-r--r--compiler/GHC/Hs/Type.hs94
-rw-r--r--compiler/GHC/Hs/Utils.hs2
8 files changed, 321 insertions, 321 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 25bcae6ce6..08eb6d80b3 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -211,12 +211,12 @@ data HsBindLR idL idR
-- 'MatchContext'. See Note [FunBind vs PatBind] for
-- details about the relationship between FunBind and PatBind.
--
- -- 'ApiAnnotation.AnnKeywordId's
+ -- 'GHC.Parser.Annotation.AnnKeywordId's
--
- -- - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
+ -- - 'GHC.Parser.Annotation.AnnFunId', attached to each element of fun_matches
--
- -- - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+ -- - 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
FunBind {
@@ -255,9 +255,9 @@ data HsBindLR idL idR
-- relationship between FunBind and PatBind.
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
- -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang',
+ -- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| PatBind {
@@ -291,7 +291,7 @@ data HsBindLR idL idR
abs_exports :: [ABExport idL],
-- | Evidence bindings
- -- Why a list? See GHC.Tc.TyCl.Instance
+ -- Why a list? See "GHC.Tc.TyCl.Instance"
-- Note [Typechecking plan for instance declarations]
abs_ev_binds :: [TcEvBinds],
@@ -305,10 +305,10 @@ data HsBindLR idL idR
| PatSynBind
(XPatSynBind idL idR)
(PatSynBind idL idR)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
- -- 'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',
- -- 'ApiAnnotation.AnnWhere'
- -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
+ -- 'GHC.Parser.Annotation.AnnLarrow','GHC.Parser.Annotation.AnnEqual',
+ -- 'GHC.Parser.Annotation.AnnWhere'
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -360,10 +360,10 @@ type instance XABE (GhcPass p) = NoExtField
type instance XXABExport (GhcPass p) = NoExtCon
--- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
--- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
--- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
--- 'ApiAnnotation.AnnClose' @'}'@,
+-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
+-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnLarrow',
+-- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen' @'{'@,
+-- 'GHC.Parser.Annotation.AnnClose' @'}'@,
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -823,7 +823,7 @@ isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
-- | Located Implicit Parameter Binding
type LIPBind id = Located (IPBind id)
--- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
+-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a
-- list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -835,7 +835,7 @@ type LIPBind id = Located (IPBind id)
-- (Right d), where "d" is the name of the dictionary holding the
-- evidence for the implicit parameter.
--
--- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data IPBind id
@@ -889,8 +889,8 @@ data Sig pass
-- signature that brought them into scope, in this third field to be
-- more specific.
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
- -- 'ApiAnnotation.AnnComma'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon',
+ -- 'GHC.Parser.Annotation.AnnComma'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
TypeSig
@@ -902,9 +902,9 @@ data Sig pass
--
-- > pattern Single :: () => (Show a) => a -> [a]
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
- -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
- -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern',
+ -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnForall'
+ -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
@@ -918,8 +918,8 @@ data Sig pass
-- default op :: Eq a => a -> a -- Generic default
-- No wildcards allowed here
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
- -- 'ApiAnnotation.AnnDcolon'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault',
+ -- 'GHC.Parser.Annotation.AnnDcolon'
| ClassOpSig (XClassOpSig pass) Bool [Located (IdP pass)] (LHsSigType pass)
-- | A type signature in generated code, notably the code
@@ -934,8 +934,8 @@ data Sig pass
-- > infixl 8 ***
--
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
- -- 'ApiAnnotation.AnnVal'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInfix',
+ -- 'GHC.Parser.Annotation.AnnVal'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| FixSig (XFixSig pass) (FixitySig pass)
@@ -944,11 +944,11 @@ data Sig pass
--
-- > {#- INLINE f #-}
--
- -- - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
- -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',
- -- 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
+ -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnTilde',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| InlineSig (XInlineSig pass)
@@ -959,12 +959,12 @@ data Sig pass
--
-- > {-# SPECIALISE f :: Int -> Int #-}
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
- -- 'ApiAnnotation.AnnTilde',
- -- 'ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,
- -- 'ApiAnnotation.AnnDcolon'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
+ -- 'GHC.Parser.Annotation.AnnTilde',
+ -- 'GHC.Parser.Annotation.AnnVal',
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@ and @'\#-}'@,
+ -- 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SpecSig (XSpecSig pass)
@@ -981,8 +981,8 @@ data Sig pass
-- (Class tys); should be a specialisation of the
-- current instance declaration
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
@@ -992,9 +992,9 @@ data Sig pass
--
-- > {-# MINIMAL a | (b, c | (d | e)) #-}
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',
- -- 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnVbar','GHC.Parser.Annotation.AnnComma',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| MinimalSig (XMinimalSig pass)
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 4b8f4228ec..543aafc828 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -135,7 +135,7 @@ import Data.Data hiding (TyCon,Fixity, Infix)
type LHsDecl p = Located (HsDecl p)
-- ^ When in a list this may have
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
--
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -541,21 +541,21 @@ type LTyClDecl pass = Located (TyClDecl pass)
data TyClDecl pass
= -- | @type/data family T :: *->*@
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
- -- 'ApiAnnotation.AnnData',
- -- 'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
- -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
- -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
- -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
- -- 'ApiAnnotation.AnnVbar'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
+ -- 'GHC.Parser.Annotation.AnnData',
+ -- 'GHC.Parser.Annotation.AnnFamily','GHC.Parser.Annotation.AnnDcolon',
+ -- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpenP',
+ -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnCloseP',
+ -- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnRarrow',
+ -- 'GHC.Parser.Annotation.AnnVbar'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
| -- | @type@ declaration
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
- -- 'ApiAnnotation.AnnEqual',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
+ -- 'GHC.Parser.Annotation.AnnEqual',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
SynDecl { tcdSExt :: XSynDecl pass -- ^ Post renameer, FVs
@@ -568,11 +568,11 @@ data TyClDecl pass
| -- | @data@ declaration
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
- -- 'ApiAnnotation.AnnFamily',
- -- 'ApiAnnotation.AnnNewType',
- -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
- -- 'ApiAnnotation.AnnWhere',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnData',
+ -- 'GHC.Parser.Annotation.AnnFamily',
+ -- 'GHC.Parser.Annotation.AnnNewType',
+ -- 'GHC.Parser.Annotation.AnnNewType','GHC.Parser.Annotation.AnnDcolon'
+ -- 'GHC.Parser.Annotation.AnnWhere',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs
@@ -594,12 +594,12 @@ data TyClDecl pass
tcdATDefs :: [LTyFamDefltDecl pass], -- ^ Associated type defaults
tcdDocs :: [LDocDecl] -- ^ Haddock docs
}
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
- -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose'
- -- - The tcdFDs will have 'ApiAnnotation.AnnVbar',
- -- 'ApiAnnotation.AnnComma'
- -- 'ApiAnnotation.AnnRarrow'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnClass',
+ -- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose'
+ -- - The tcdFDs will have 'GHC.Parser.Annotation.AnnVbar',
+ -- 'GHC.Parser.Annotation.AnnComma'
+ -- 'GHC.Parser.Annotation.AnnRarrow'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XTyClDecl !(XXTyClDecl pass)
@@ -1048,21 +1048,21 @@ type LFamilyResultSig pass = Located (FamilyResultSig pass)
-- | type Family Result Signature
data FamilyResultSig pass = -- see Note [FamilyResultSig]
NoSig (XNoSig pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' :
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| KindSig (XCKindSig pass) (LHsKind pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
- -- 'ApiAnnotation.AnnCloseP'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon',
+ -- 'GHC.Parser.Annotation.AnnCloseP'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| TyVarSig (XTyVarSig pass) (LHsTyVarBndr () pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
- -- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon',
+ -- 'GHC.Parser.Annotation.AnnCloseP', 'GHC.Parser.Annotation.AnnEqual'
| XFamilyResultSig !(XXFamilyResultSig pass)
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1089,12 +1089,12 @@ data FamilyDecl pass = FamilyDecl
, fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
}
| XFamilyDecl !(XXFamilyDecl pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
- -- 'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
- -- 'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
- -- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',
- -- 'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
- -- 'ApiAnnotation.AnnVbar'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
+ -- 'GHC.Parser.Annotation.AnnData', 'GHC.Parser.Annotation.AnnFamily',
+ -- 'GHC.Parser.Annotation.AnnWhere', 'GHC.Parser.Annotation.AnnOpenP',
+ -- 'GHC.Parser.Annotation.AnnDcolon', 'GHC.Parser.Annotation.AnnCloseP',
+ -- 'GHC.Parser.Annotation.AnnEqual', 'GHC.Parser.Annotation.AnnRarrow',
+ -- 'GHC.Parser.Annotation.AnnVbar'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1115,8 +1115,8 @@ type LInjectivityAnn pass = Located (InjectivityAnn pass)
-- This will be represented as "InjectivityAnn `r` [`a`, `c`]"
data InjectivityAnn pass
= InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]
- -- ^ - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnRarrow', 'GHC.Parser.Annotation.AnnVbar'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1256,10 +1256,10 @@ type LHsDerivingClause pass = Located (HsDerivingClause pass)
-- | A single @deriving@ clause of a data declaration.
--
--- - 'ApiAnnotation.AnnKeywordId' :
--- 'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
--- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
--- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+-- - 'GHC.Parser.Annotation.AnnKeywordId' :
+-- 'GHC.Parser.Annotation.AnnDeriving', 'GHC.Parser.Annotation.AnnStock',
+-- 'GHC.Parser.Annotation.AnnAnyClass', 'Api.AnnNewtype',
+-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
data HsDerivingClause pass
-- See Note [Deriving strategies] in GHC.Tc.Deriv
= HsDerivingClause
@@ -1348,7 +1348,7 @@ newOrDataToFlavour DataType = DataTypeFlavour
-- | Located data Constructor Declaration
type LConDecl pass = Located (ConDecl pass)
- -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
+ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when
-- in a GADT constructor list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1369,11 +1369,11 @@ type LConDecl pass = Located (ConDecl pass)
-- Int `MkT` Int :: T Int
-- @
--
--- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
--- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',
--- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',
--- 'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',
--- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'
+-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
+-- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnCLose',
+-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnVbar',
+-- 'GHC.Parser.Annotation.AnnDarrow','GHC.Parser.Annotation.AnnDarrow',
+-- 'GHC.Parser.Annotation.AnnForall','GHC.Parser.Annotation.AnnDot'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1722,7 +1722,7 @@ free-standing `type instance` declaration.
-- | Located Type Family Instance Equation
type LTyFamInstEqn pass = Located (TyFamInstEqn pass)
- -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
-- when in a list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1781,8 +1781,8 @@ type LTyFamInstDecl pass = Located (TyFamInstDecl pass)
-- | Type Family Instance Declaration
newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
- -- 'ApiAnnotation.AnnInstance',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
+ -- 'GHC.Parser.Annotation.AnnInstance',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1795,11 +1795,11 @@ type LDataFamInstDecl pass = Located (DataFamInstDecl pass)
newtype DataFamInstDecl pass
= DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
- -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
- -- 'ApiAnnotation.AnnDcolon'
- -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnData',
+ -- 'GHC.Parser.Annotation.AnnNewType','GHC.Parser.Annotation.AnnInstance',
+ -- 'GHC.Parser.Annotation.AnnDcolon'
+ -- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1829,7 +1829,7 @@ data FamEqn pass rhs
, feqn_rhs :: rhs
}
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
| XFamEqn !(XXFamEqn pass rhs)
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1854,15 +1854,15 @@ data ClsInstDecl pass
, cid_tyfam_insts :: [LTyFamInstDecl pass] -- Type family instances
, cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
, cid_overlap_mode :: Maybe (Located OverlapMode)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose',
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
}
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',
- -- 'ApiAnnotation.AnnWhere',
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInstance',
+ -- 'GHC.Parser.Annotation.AnnWhere',
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XClsInstDecl !(XXClsInstDecl pass)
@@ -2049,10 +2049,10 @@ data DerivDecl pass = DerivDecl
, deriv_strategy :: Maybe (LDerivStrategy pass)
, deriv_overlap_mode :: Maybe (Located OverlapMode)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
- -- 'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',
- -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDeriving',
+ -- 'GHC.Parser.Annotation.AnnInstance', 'GHC.Parser.Annotation.AnnStock',
+ -- 'GHC.Parser.Annotation.AnnAnyClass', 'Api.AnnNewtype',
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
}
@@ -2152,8 +2152,8 @@ type LDefaultDecl pass = Located (DefaultDecl pass)
-- | Default Declaration
data DefaultDecl pass
= DefaultDecl (XCDefaultDecl pass) [LHsType pass]
- -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnDefault',
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XDefaultDecl !(XXDefaultDecl pass)
@@ -2197,9 +2197,9 @@ data ForeignDecl pass
, fd_sig_ty :: LHsSigType pass -- sig_ty
, fd_fe :: ForeignExport }
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
- -- 'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',
- -- 'ApiAnnotation.AnnDcolon'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForeign',
+ -- 'GHC.Parser.Annotation.AnnImport','GHC.Parser.Annotation.AnnExport',
+ -- 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XForeignDecl !(XXForeignDecl pass)
@@ -2339,7 +2339,7 @@ data RuleDecl pass
{ rd_ext :: XHsRule pass
-- ^ After renamer, free-vars from the LHS and RHS
, rd_name :: Located (SourceText,RuleName)
- -- ^ Note [Pragma source text] in GHC.Types.Basic
+ -- ^ Note [Pragma source text] in "GHC.Types.Basic"
, rd_act :: Activation
, rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)]
-- ^ Forall'd type vars
@@ -2350,12 +2350,12 @@ data RuleDecl pass
, rd_rhs :: Located (HsExpr pass)
}
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
- -- 'ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnClose',
- -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
- -- 'ApiAnnotation.AnnEqual',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnTilde',
+ -- 'GHC.Parser.Annotation.AnnVal',
+ -- 'GHC.Parser.Annotation.AnnClose',
+ -- 'GHC.Parser.Annotation.AnnForall','GHC.Parser.Annotation.AnnDot',
+ -- 'GHC.Parser.Annotation.AnnEqual',
| XRuleDecl !(XXRuleDecl pass)
data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
@@ -2379,8 +2379,8 @@ data RuleBndr pass
| RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (HsPatSigType pass)
| XRuleBndr !(XXRuleBndr pass)
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -2513,10 +2513,10 @@ data AnnDecl pass = HsAnnotation
(XHsAnnotation pass)
SourceText -- Note [Pragma source text] in GHC.Types.Basic
(AnnProvenance (IdP pass)) (Located (HsExpr pass))
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnType'
- -- 'ApiAnnotation.AnnModule'
- -- 'ApiAnnotation.AnnClose'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnType'
+ -- 'GHC.Parser.Annotation.AnnModule'
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XAnnDecl !(XXAnnDecl pass)
@@ -2567,8 +2567,8 @@ data RoleAnnotDecl pass
= RoleAnnotDecl (XCRoleAnnotDecl pass)
(Located (IdP pass)) -- type constructor
[Located (Maybe Role)] -- optional annotations
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
- -- 'ApiAnnotation.AnnRole'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
+ -- 'GHC.Parser.Annotation.AnnRole'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XRoleAnnotDecl !(XXRoleAnnotDecl pass)
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index e7e71bac2f..20aeb72872 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -74,7 +74,7 @@ import qualified Language.Haskell.TH as TH (Q)
-- | Located Haskell Expression
type LHsExpr p = Located (HsExpr p)
- -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -280,16 +280,16 @@ data HsExpr p
(MatchGroup p (LHsExpr p))
-- ^ Lambda abstraction. Currently always a single match
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
- -- 'ApiAnnotation.AnnRarrow',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
+ -- 'GHC.Parser.Annotation.AnnRarrow',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
- -- 'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
+ -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -302,7 +302,7 @@ data HsExpr p
-- Explicit type argument; e.g f @Int x y
-- NB: Has wildcards, but no implicit quantification
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt',
-- | Operator applications:
-- NB Bracketed ops such as (+) come out as Vars.
@@ -318,15 +318,15 @@ data HsExpr p
-- | Negation operator. Contains the negated expression and the name
-- of 'negate'
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| NegApp (XNegApp p)
(LHsExpr p)
(SyntaxExpr p)
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsPar (XPar p)
@@ -341,8 +341,8 @@ data HsExpr p
-- | Used for explicit tuples and sections thereof
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
-- Note [ExplicitTuple]
@@ -353,10 +353,10 @@ data HsExpr p
-- | Used for unboxed sum types
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
- -- 'ApiAnnotation.AnnVbar', 'ApiAnnotation.AnnClose' @'#)'@,
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
+ -- 'GHC.Parser.Annotation.AnnVbar', 'GHC.Parser.Annotation.AnnClose' @'#)'@,
--
- -- There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before
+ -- There will be multiple 'GHC.Parser.Annotation.AnnVbar', (1 - alternative) before
-- the expression, (arity - alternative) after it
| ExplicitSum
(XExplicitSum p)
@@ -364,19 +364,19 @@ data HsExpr p
Arity -- Sum arity
(LHsExpr p)
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
- -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase',
+ -- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCase (XCase p)
(LHsExpr p)
(MatchGroup p (LHsExpr p))
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
- -- 'ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnElse',
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf',
+ -- 'GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnElse',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsIf (XIf p) -- GhcPs: this is a Bool; False <=> do not use
@@ -390,27 +390,27 @@ data HsExpr p
-- | Multi-way if
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
- -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf'
+ -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)]
-- | let(rec)
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
- -- 'ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsLet (XLet p)
(LHsLocalBinds p)
(LHsExpr p)
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
- -- 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnVbar',
- -- 'ApiAnnotation.AnnClose'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',
+ -- 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnVbar',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsDo (XDo p) -- Type of the whole expression
@@ -421,8 +421,8 @@ data HsExpr p
-- | Syntactic list: [a,b,c,...]
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
- -- 'ApiAnnotation.AnnClose' @']'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
-- See Note [Empty lists]
@@ -434,8 +434,8 @@ data HsExpr p
-- | Record construction
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| RecordCon
@@ -446,8 +446,8 @@ data HsExpr p
-- | Record update
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| RecordUpd
@@ -460,7 +460,7 @@ data HsExpr p
-- | Expression with an explicit type signature. @e :: type@
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| ExprWithTySig
@@ -471,9 +471,9 @@ data HsExpr p
-- | Arithmetic sequence
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
- -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
- -- 'ApiAnnotation.AnnClose' @']'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
+ -- 'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnDotdot',
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| ArithSeq
@@ -487,9 +487,9 @@ data HsExpr p
-----------------------------------------------------------
-- MetaHaskell Extensions
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',
- -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnOpenE','GHC.Parser.Annotation.AnnOpenEQ',
+ -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnCloseQ'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsBracket (XBracket p) (HsBracket p)
@@ -510,8 +510,8 @@ data HsExpr p
[PendingTcSplice] -- _typechecked_ splices to be
-- pasted back in by the desugarer
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsSpliceE (XSpliceE p) (HsSplice p)
@@ -521,8 +521,8 @@ data HsExpr p
-- | @proc@ notation for Arrows
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
- -- 'ApiAnnotation.AnnRarrow'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnProc',
+ -- 'GHC.Parser.Annotation.AnnRarrow'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsProc (XProc p)
@@ -532,7 +532,7 @@ data HsExpr p
---------------------------------------
-- static pointers extension
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnStatic',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsStatic (XStatic p) -- Free variables of the body
@@ -581,8 +581,8 @@ data RecordUpdTc = RecordUpdTc
-- | HsWrap appears only in typechecker output
-- Invariant: The contained Expr is *NOT* itself an HsWrap.
--- See Note [Detecting forced eta expansion] in GHC.HsToCore.Expr.
--- This invariant is maintained by GHC.Hs.Utils.mkHsWrap.
+-- See Note [Detecting forced eta expansion] in "GHC.HsToCore.Expr".
+-- This invariant is maintained by 'GHC.Hs.Utils.mkHsWrap'.
-- hs_syn is something like HsExpr or HsCmd
data HsWrap hs_syn = HsWrap HsWrapper -- the wrapper
(hs_syn GhcTc) -- the thing that is wrapped
@@ -684,22 +684,22 @@ data HsPragE p
SourceText -- Note [Pragma source text] in GHC.Types.Basic
StringLiteral -- "set cost centre" SCC pragma
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
- -- 'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{-\# CORE'@,
+ -- 'GHC.Parser.Annotation.AnnVal', 'GHC.Parser.Annotation.AnnClose' @'\#-}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsPragCore (XCoreAnn p)
SourceText -- Note [Pragma source text] in GHC.Types.Basic
StringLiteral -- hdaume: core annotation
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
- -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnMinus',
- -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',
- -- 'ApiAnnotation.AnnVal',
- -- 'ApiAnnotation.AnnClose' @'\#-}'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# GENERATED'@,
+ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnVal',
+ -- 'GHC.Parser.Annotation.AnnColon','GHC.Parser.Annotation.AnnVal',
+ -- 'GHC.Parser.Annotation.AnnMinus',
+ -- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnColon',
+ -- 'GHC.Parser.Annotation.AnnVal',
+ -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsPragTick -- A pragma introduced tick
@@ -725,7 +725,7 @@ type instance XXPragE (GhcPass _) = NoExtCon
-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@
-- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@
type LHsTupArg id = Located (HsTupArg id)
--- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
+-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1276,9 +1276,9 @@ type LHsCmd id = Located (HsCmd id)
-- | Haskell Command (e.g. a "statement" in an Arrow proc block)
data HsCmd id
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
- -- 'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
- -- 'ApiAnnotation.AnnRarrowtail'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.Annlarrowtail',
+ -- 'GHC.Parser.Annotation.Annrarrowtail','GHC.Parser.Annotation.AnnLarrowtail',
+ -- 'GHC.Parser.Annotation.AnnRarrowtail'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
= HsCmdArrApp -- Arrow tail, or arrow application (f -< arg)
@@ -1290,8 +1290,8 @@ data HsCmd id
Bool -- True => right-to-left (f -< arg)
-- False => left-to-right (arg >- f)
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
- -- 'ApiAnnotation.AnnCloseB' @'|)'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenB' @'(|'@,
+ -- 'GHC.Parser.Annotation.AnnCloseB' @'|)'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |)
@@ -1311,32 +1311,32 @@ data HsCmd id
| HsCmdLam (XCmdLam id)
(MatchGroup id (LHsCmd id)) -- kappa
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
- -- 'ApiAnnotation.AnnRarrow',
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
+ -- 'GHC.Parser.Annotation.AnnRarrow',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdPar (XCmdPar id)
(LHsCmd id) -- parenthesised command
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdCase (XCmdCase id)
(LHsExpr id)
(MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
- -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase',
+ -- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdLamCase (XCmdLamCase id)
(MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
- -- 'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
+ -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1345,28 +1345,28 @@ data HsCmd id
(LHsExpr id) -- predicate
(LHsCmd id) -- then part
(LHsCmd id) -- else part
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
- -- 'ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnElse',
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf',
+ -- 'GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnElse',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdLet (XCmdLet id)
(LHsLocalBinds id) -- let(rec)
(LHsCmd id)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
- -- 'ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsCmdDo (XCmdDo id) -- Type of the whole expression
(Located [CmdLStmt id])
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
- -- 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
- -- 'ApiAnnotation.AnnVbar',
- -- 'ApiAnnotation.AnnClose'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',
+ -- 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi',
+ -- 'GHC.Parser.Annotation.AnnVbar',
+ -- 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1586,7 +1586,7 @@ type instance XXMatchGroup (GhcPass _) b = NoExtCon
-- | Located Match
type LMatch id body = Located (Match id body)
--- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
+-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a
-- list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1676,10 +1676,10 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats
--
-- GRHSs are used both for pattern bindings and for Matches
--
--- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
--- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
--- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
--- 'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar',
+-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
+-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
+-- 'GHC.Parser.Annotation.AnnRarrow','GHC.Parser.Annotation.AnnSemi'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data GRHSs p body
@@ -1826,10 +1826,10 @@ type GhciStmt id = Stmt id (LHsExpr id)
-- The SyntaxExprs in here are used *only* for do-notation and monad
-- comprehensions, which have rebindable syntax. Otherwise they are unused.
-- | API Annotations when in qualifier lists or guards
--- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVbar',
--- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnThen',
--- 'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy',
--- 'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing'
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVbar',
+-- 'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnThen',
+-- 'GHC.Parser.Annotation.AnnBy','GHC.Parser.Annotation.AnnBy',
+-- 'GHC.Parser.Annotation.AnnGroup','GHC.Parser.Annotation.AnnUsing'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data StmtLR idL idR body -- body should always be (LHs**** idR)
@@ -1847,7 +1847,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- For ListComp we use the baked-in 'return'
-- For DoExpr, MDoExpr, we don't apply a 'return' at all
-- See Note [Monad Comprehensions]
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLarrow'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| BindStmt (XBindStmt idL idR body)
@@ -1864,7 +1864,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- appropriate applicative expression by the desugarer, but it is intended
-- to be invisible in error messages.
--
- -- For full details, see Note [ApplicativeDo] in GHC.Rename.Expr
+ -- For full details, see Note [ApplicativeDo] in "GHC.Rename.Expr"
--
| ApplicativeStmt
(XApplicativeStmt idL idR body) -- Post typecheck, Type of the body
@@ -1880,8 +1880,8 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
(SyntaxExpr idR) -- The `guard` operator; used only in MonadComp
-- See notes [Monad Comprehensions]
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
- -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet'
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@,
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)
@@ -1919,7 +1919,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
} -- See Note [Monad Comprehensions]
-- Recursive statement (see Note [How RecStmt works] below)
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRec'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| RecStmt
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 2257352b63..48534bc910 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -46,7 +46,7 @@ One per \tr{import} declaration in a module.
type LImportDecl pass = Located (ImportDecl pass)
-- ^ When in a list this may have
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -59,7 +59,7 @@ data ImportDeclQualifiedStyle
-- | Given two possible located 'qualified' tokens, compute a style
-- (in a conforming Haskell program only one of the two can be not
--- 'Nothing'). This is called from 'GHC.Parser'.
+-- 'Nothing'). This is called from "GHC.Parser".
importDeclQualifiedStyle :: Maybe (Located a)
-> Maybe (Located a)
-> ImportDeclQualifiedStyle
@@ -93,18 +93,18 @@ data ImportDecl pass
}
| XImportDecl !(XXImportDecl pass)
-- ^
- -- 'ApiAnnotation.AnnKeywordId's
+ -- 'GHC.Parser.Annotation.AnnKeywordId's
--
- -- - 'ApiAnnotation.AnnImport'
+ -- - 'GHC.Parser.Annotation.AnnImport'
--
- -- - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource
+ -- - 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnClose' for ideclSource
--
- -- - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',
- -- 'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',
- -- 'ApiAnnotation.AnnVal'
+ -- - 'GHC.Parser.Annotation.AnnSafe','GHC.Parser.Annotation.AnnQualified',
+ -- 'GHC.Parser.Annotation.AnnPackageName','GHC.Parser.Annotation.AnnAs',
+ -- 'GHC.Parser.Annotation.AnnVal'
--
- -- - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose' attached
+ -- - 'GHC.Parser.Annotation.AnnHiding','GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose' attached
-- to location in ideclHiding
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -186,8 +186,8 @@ data IEWrappedName name
deriving (Eq,Data)
-- | Located name with possible adornment
--- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
--- 'ApiAnnotation.AnnPattern'
+-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType',
+-- 'GHC.Parser.Annotation.AnnPattern'
type LIEWrappedName name = Located (IEWrappedName name)
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -196,7 +196,7 @@ type LIEWrappedName name = Located (IEWrappedName name)
type LIE pass = Located (IE pass)
-- ^ When in a list this may have
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -209,8 +209,8 @@ data IE pass
-- ^ Imported or exported Thing with Absent list
--
-- The thing is a Class/Type (can't tell)
- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
- -- 'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern',
+ -- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
@@ -219,9 +219,9 @@ data IE pass
--
-- The thing is a Class/Type and the All refers to methods/constructors
--
- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',
- -- 'ApiAnnotation.AnnType'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose',
+ -- 'GHC.Parser.Annotation.AnnType'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
@@ -235,10 +235,10 @@ data IE pass
--
-- The thing is a Class/Type and the imported or exported things are
-- methods/constructors and record fields; see Note [IEThingWith]
- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnClose',
- -- 'ApiAnnotation.AnnComma',
- -- 'ApiAnnotation.AnnType'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnClose',
+ -- 'GHC.Parser.Annotation.AnnComma',
+ -- 'GHC.Parser.Annotation.AnnType'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| IEModuleContents (XIEModuleContents pass) (Located ModuleName)
@@ -246,7 +246,7 @@ data IE pass
--
-- (Export Only)
--
- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| IEGroup (XIEGroup pass) Int HsDocString -- ^ Doc section heading
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index 78155289d0..4396e78004 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -57,7 +57,7 @@ data HsLit x
-- ^ Packed bytes
| HsInt (XHsInt x) IntegralLit
-- ^ Genuinely an Int; arises from
- -- @GHC.Tc.Deriv.Generate@, and from TRANSLATION
+ -- "GHC.Tc.Deriv.Generate", and from TRANSLATION
| HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
-- ^ literal @Int#@
| HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 0e29797b43..adadcdbd7d 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -82,7 +82,7 @@ type LPat p = XRec p Pat
-- | Pattern
--
--- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data Pat p
@@ -98,26 +98,26 @@ data Pat p
-- See Note [Located RdrNames] in GHC.Hs.Expr
| LazyPat (XLazyPat p)
(LPat p) -- ^ Lazy Pattern
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| AsPat (XAsPat p)
(Located (IdP p)) (LPat p) -- ^ As pattern
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| ParPat (XParPat p)
(LPat p) -- ^ Parenthesised pattern
-- See Note [Parens in HsSyn] in GHC.Hs.Expr
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| BangPat (XBangPat p)
(LPat p) -- ^ Bang pattern
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -130,8 +130,8 @@ data Pat p
-- ^ Syntactic List
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
- -- 'ApiAnnotation.AnnClose' @']'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -157,9 +157,9 @@ data Pat p
-- will be wrapped in CoPats, no?)
-- ^ Tuple sub-patterns
--
- -- - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
- -- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@ or @'#)'@
| SumPat (XSumPat p) -- after typechecker, types of the alternative
(LPat p) -- Sum sub-pattern
@@ -167,9 +167,9 @@ data Pat p
Arity -- Arity (INVARIANT: ≥ 2)
-- ^ Anonymous sum pattern
--
- -- - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen' @'(#'@,
- -- 'ApiAnnotation.AnnClose' @'#)'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'#)'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -182,7 +182,7 @@ data Pat p
-- ^ Constructor Pattern
------------ View patterns ---------------
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| ViewPat (XViewPat p) -- The overall type of the pattern
@@ -193,8 +193,8 @@ data Pat p
-- ^ View Pattern
------------ Pattern splices ---------------
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SplicePat (XSplicePat p)
@@ -220,7 +220,7 @@ data Pat p
-- ^ Natural Pattern
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| NPlusKPat (XNPlusKPat p) -- Type of overall pattern
@@ -235,7 +235,7 @@ data Pat p
-- ^ n+k pattern
------------ Pattern type signatures ---------------
- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+ -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| SigPat (XSigPat p) -- After typechecker: Type
@@ -416,7 +416,7 @@ type HsRecUpdField p = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
-- | Haskell Record Field
--
--- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',
+-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',
--
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data HsRecField' id arg = HsRecField {
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 7ee898a90f..ccf98857f4 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -304,7 +304,7 @@ quantified in left-to-right order in kind signatures is nice since:
-- | Located Haskell Context
type LHsContext pass = Located (HsContext pass)
- -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'
+ -- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnUnit'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
noLHsContext :: LHsContext pass
@@ -320,7 +320,7 @@ type HsContext pass = [LHsType pass]
-- | Located Haskell Type
type LHsType pass = Located (HsType pass)
- -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -330,7 +330,7 @@ type HsKind pass = HsType pass
-- | Located Haskell Kind
type LHsKind pass = Located (HsKind pass)
- -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+ -- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -646,8 +646,8 @@ data HsTyVarBndr flag pass
(Located (IdP pass))
(LHsKind pass) -- The user-supplied kind signature
-- ^
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
- -- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
+ -- 'GHC.Parser.Annotation.AnnDcolon', 'GHC.Parser.Annotation.AnnClose'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -692,9 +692,9 @@ data HsType pass
-- Explicit, user-supplied 'forall a {b} c'
, hst_body :: LHsType pass -- body type
}
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
- -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
- -- For details on above see note [Api annotations] in GHC.Parser.Annotation
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForall',
+ -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'
+ -- For details on above see note [Api annotations] in "GHC.Parser.Annotation"
| HsQualTy -- See Note [HsType binders]
{ hst_xqual :: XQualTy pass
@@ -708,14 +708,14 @@ data HsType pass
-- Type variable, type constructor, or data constructor
-- see Note [Promotions (HsTyVar)]
-- See Note [Located RdrNames] in GHC.Hs.Expr
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsAppTy (XAppTy pass)
(LHsType pass)
(LHsType pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -727,35 +727,35 @@ data HsType pass
(HsArrow pass)
(LHsType pass) -- function type
(LHsType pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow',
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsListTy (XListTy pass)
(LHsType pass) -- Element type
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
- -- 'ApiAnnotation.AnnClose' @']'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsTupleTy (XTupleTy pass)
HsTupleSort
[LHsType pass] -- Element types (length gives arity)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,
- -- 'ApiAnnotation.AnnClose' @')' or '#)'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(' or '(#'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')' or '#)'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsSumTy (XSumTy pass)
[LHsType pass] -- Element types (length gives arity)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
- -- 'ApiAnnotation.AnnClose' '#)'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
+ -- 'GHC.Parser.Annotation.AnnClose' '#)'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsOpTy (XOpTy pass)
(LHsType pass) (Located (IdP pass)) (LHsType pass)
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -764,8 +764,8 @@ data HsType pass
-- Parenthesis preserved for the precedence re-arrangement in
-- GHC.Rename.HsType
-- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -776,14 +776,14 @@ data HsType pass
-- ^
-- > (?x :: ty)
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsStarTy (XStarTy pass)
Bool -- Is this the Unicode variant?
-- Note [HsStarTy]
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
| HsKindSig (XKindSig pass)
(LHsType pass) -- (ty :: kind)
@@ -791,43 +791,43 @@ data HsType pass
-- ^
-- > (ty :: kind)
--
- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
- -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@
+ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
+ -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsSpliceTy (XSpliceTy pass)
(HsSplice pass) -- Includes quasi-quotes
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsDocTy (XDocTy pass)
(LHsType pass) LHsDocString -- A documented type
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsBangTy (XBangTy pass)
HsSrcBang (LHsType pass) -- Bang-style type annotations
- -- ^ - 'ApiAnnotation.AnnKeywordId' :
- -- 'ApiAnnotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,
- -- 'ApiAnnotation.AnnClose' @'#-}'@
- -- 'ApiAnnotation.AnnBang' @\'!\'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
+ -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'#-}'@
+ -- 'GHC.Parser.Annotation.AnnBang' @\'!\'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsRecTy (XRecTy pass)
[LConDeclField pass] -- Only in data type declarations
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
- -- 'ApiAnnotation.AnnClose' @'}'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
+ -- 'GHC.Parser.Annotation.AnnClose' @'}'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
-- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed*
-- -- Core Type through HsSyn.
- -- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -835,27 +835,27 @@ data HsType pass
(XExplicitListTy pass)
PromotionFlag -- whether explicitly promoted, for pretty printer
[LHsType pass]
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
- -- 'ApiAnnotation.AnnClose' @']'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'["@,
+ -- 'GHC.Parser.Annotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsExplicitTupleTy -- A promoted explicit tuple
(XExplicitTupleTy pass)
[LHsType pass]
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
- -- 'ApiAnnotation.AnnClose' @')'@
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'("@,
+ -- 'GHC.Parser.Annotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsTyLit (XTyLit pass) HsTyLit -- A promoted numeric literal.
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| HsWildCardTy (XWildCardTy pass) -- A type wildcard
-- See Note [The wildcard story for types]
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -867,7 +867,7 @@ data NewHsTypeX
= NHsCoreTy Type -- An escape hatch for tunnelling a *closed*
-- Core Type through HsSyn.
deriving Data
- -- ^ - 'ApiAnnotation.AnnKeywordId' : None
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
instance Outputable NewHsTypeX where
ppr (NHsCoreTy ty) = ppr ty
@@ -1074,7 +1074,7 @@ data HsTupleSort = HsUnboxedTuple
-- | Located Constructor Declaration Field
type LConDeclField pass = Located (ConDeclField pass)
- -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
+ -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
@@ -1086,7 +1086,7 @@ data ConDeclField pass -- Record fields have Haddock docs on them
-- ^ See Note [ConDeclField passs]
cd_fld_type :: LBangType pass,
cd_fld_doc :: Maybe LHsDocString }
- -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
+ -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
| XConDeclField !(XXConDeclField pass)
@@ -1556,7 +1556,7 @@ type LFieldOcc pass = Located (FieldOcc pass)
-- renamer, the selector function.
data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass
, rdrNameFieldOcc :: Located RdrName
- -- ^ See Note [Located RdrNames] in GHC.Hs.Expr
+ -- ^ See Note [Located RdrNames] in "GHC.Hs.Expr"
}
| XFieldOcc
@@ -1585,9 +1585,9 @@ mkFieldOcc rdr = FieldOcc noExtField rdr
-- (for unambiguous occurrences) or the typechecker (for ambiguous
-- occurrences).
--
--- See Note [HsRecField and HsRecUpdField] in GHC.Hs.Pat and
--- Note [Disambiguating record fields] in GHC.Tc.Gen.Expr.
--- See Note [Located RdrNames] in GHC.Hs.Expr
+-- See Note [HsRecField and HsRecUpdField] in "GHC.Hs.Pat" and
+-- Note [Disambiguating record fields] in "GHC.Tc.Gen.Expr".
+-- See Note [Located RdrNames] in "GHC.Hs.Expr"
data AmbiguousFieldOcc pass
= Unambiguous (XUnambiguous pass) (Located RdrName)
| Ambiguous (XAmbiguous pass) (Located RdrName)
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 6cad3c71e9..1c8023946c 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -1002,7 +1002,7 @@ BUT we have a special case when abs_sig is true;
-- | Should we treat this as an unlifted bind? This will be true for any
-- bind that binds an unlifted variable, but we must be careful around
-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
--- information, see Note [Strict binds check] is GHC.HsToCore.Binds.
+-- information, see Note [Strict binds check] is "GHC.HsToCore.Binds".
isUnliftedHsBind :: HsBind GhcTc -> Bool -- works only over typechecked binds
isUnliftedHsBind bind
| AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind