summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2022-01-30 08:45:46 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-01 12:29:26 -0500
commit06185102bb06d6d56e00d40172a6a473fc228501 (patch)
tree55d92897b9688ea6e1597fad2c33c1e13d1e0053
parentfdda93b03e9be56122dd8445e7ee0f1d0f933a19 (diff)
downloadhaskell-06185102bb06d6d56e00d40172a6a473fc228501.tar.gz
Consistently upper-case "Note ["
This was achieved with git ls-tree --name-only HEAD -r | xargs sed -i -e 's/note \[/Note \[/g'
-rw-r--r--compiler/GHC/Cmm/CLabel.hs2
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/Instr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Instr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/Instr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs2
-rw-r--r--compiler/GHC/CmmToLlvm/Base.hs2
-rw-r--r--compiler/GHC/CmmToLlvm/Data.hs2
-rw-r--r--compiler/GHC/Core/Class.hs2
-rw-r--r--compiler/GHC/Core/Coercion.hs2
-rw-r--r--compiler/GHC/Core/DataCon.hs2
-rw-r--r--compiler/GHC/Core/InstEnv.hs2
-rw-r--r--compiler/GHC/Core/Opt/CallArity.hs6
-rw-r--r--compiler/GHC/Core/Opt/Exitify.hs2
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs6
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs2
-rw-r--r--compiler/GHC/Core/Rules.hs2
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs2
-rw-r--r--compiler/GHC/Driver/Session.hs4
-rw-r--r--compiler/GHC/Hs.hs8
-rw-r--r--compiler/GHC/Hs/Expr.hs2
-rw-r--r--compiler/GHC/Hs/ImpExp.hs16
-rw-r--r--compiler/GHC/HsToCore/Quote.hs12
-rw-r--r--compiler/GHC/Iface/Recomp/Flags.hs2
-rw-r--r--compiler/GHC/Iface/Tidy.hs2
-rw-r--r--compiler/GHC/Iface/Type.hs-boot2
-rw-r--r--compiler/GHC/Parser/Annotation.hs2
-rw-r--r--compiler/GHC/Parser/Lexer.x4
-rw-r--r--compiler/GHC/Parser/PostProcess.hs2
-rw-r--r--compiler/GHC/Rename/Pat.hs2
-rw-r--r--compiler/GHC/Rename/Unbound.hs2
-rw-r--r--compiler/GHC/Stg/CSE.hs14
-rw-r--r--compiler/GHC/StgToCmm/Bind.hs2
-rw-r--r--compiler/GHC/StgToCmm/Expr.hs4
-rw-r--r--compiler/GHC/SysTools/BaseDir.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Arrow.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs2
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Build.hs2
-rw-r--r--compiler/GHC/Tc/Utils/TcMType.hs2
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs2
-rw-r--r--compiler/GHC/Types/Basic.hs6
-rw-r--r--compiler/GHC/Types/ForeignCall.hs6
-rw-r--r--compiler/GHC/Types/Name/Reader.hs2
-rw-r--r--compiler/GHC/Types/TyThing.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Binds.hs26
-rw-r--r--compiler/Language/Haskell/Syntax/Decls.hs50
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs80
-rw-r--r--compiler/Language/Haskell/Syntax/Pat.hs24
-rw-r--r--compiler/Language/Haskell/Syntax/Type.hs50
-rw-r--r--ghc/GHCi/UI.hs2
54 files changed, 198 insertions, 198 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index de608bafd4..fd9f019e04 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -1617,7 +1617,7 @@ pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
-- GNU assembly alias ('.equiv' directive). Sadly, there is
-- no such thing as an alias to an imported symbol (conf.
-- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
--- See note [emit-time elimination of static indirections].
+-- See Note [emit-time elimination of static indirections].
--
-- Precondition is that both labels represent the
-- same semantic value.
diff --git a/compiler/GHC/CmmToAsm/AArch64/Instr.hs b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
index 001ae959c7..25342fd66a 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Instr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Instr.hs
@@ -446,7 +446,7 @@ mkStackDeallocInstr platform n
mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n)
--
--- See note [extra spill slots] in X86/Instr.hs
+-- See Note [extra spill slots] in X86/Instr.hs
--
allocMoreStack
:: Platform
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index 16a28ba666..b8fc53e201 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -97,7 +97,7 @@ mkStackAllocInstr' platform amount
immAmount = ImmInt amount
--
--- See note [extra spill slots] in X86/Instr.hs
+-- See Note [extra spill slots] in X86/Instr.hs
--
allocMoreStack
:: Platform
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 3deccb6663..99776cc7f4 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -154,7 +154,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprDatas :: Platform -> RawCmmStatics -> SDoc
--- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
+-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 8eff3b1952..947a25b2d8 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -851,7 +851,7 @@ mkStackAllocInstr platform amount
-- there are no expectations for volatile registers.
--
-- 3. When the target is a local branch point it is re-targeted
- -- after the dealloc, preserving #2. See note [extra spill slots].
+ -- after the dealloc, preserving #2. See Note [extra spill slots].
--
-- We emit a call because the stack probes are quite involved and
-- would bloat code size a lot. GHC doesn't really have an -Os.
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 8e0fb08c7f..15e1b961df 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -170,7 +170,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprDatas :: NCGConfig -> (Alignment, RawCmmStatics) -> SDoc
--- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
+-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index af186a3486..b209c4cd67 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -553,7 +553,7 @@ generateExternDecls = do
-- | Here we take a global variable definition, rename it with a
-- @$def@ suffix, and generate the appropriate alias.
aliasify :: LMGlobal -> LlvmM [LMGlobal]
--- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
+-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
-- Here we obtain the indirectee's precise type and introduce
-- fresh aliases to both the precise typed label (lbl$def) and the i8*
-- typed (regular) label of it with the matching new names.
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
index c532770a4d..0e5679887d 100644
--- a/compiler/GHC/CmmToLlvm/Data.hs
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -41,7 +41,7 @@ linkage lbl = if externallyVisibleCLabel lbl
-- | Pass a CmmStatic section to an equivalent Llvm code.
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
--- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
+-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
genLlvmData (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
diff --git a/compiler/GHC/Core/Class.hs b/compiler/GHC/Core/Class.hs
index 99359fc2a1..9ad470e9da 100644
--- a/compiler/GHC/Core/Class.hs
+++ b/compiler/GHC/Core/Class.hs
@@ -79,7 +79,7 @@ data Class
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'',
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
type FunDep a = ([a],[a])
type ClassOpItem = (Id, DefMethInfo)
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 656b5addae..6f5c1ac338 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -1635,7 +1635,7 @@ mkFamilyTyConAppCo tc cos
| otherwise
= mkTyConAppCo Nominal tc cos
--- See note [Newtype coercions] in GHC.Core.TyCon
+-- See Note [Newtype coercions] in GHC.Core.TyCon
mkPiCos :: Role -> [Var] -> Coercion -> Coercion
mkPiCos r vs co = foldr (mkPiCo r) co vs
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index e95e68441f..feca5d3754 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -338,7 +338,7 @@ Some other notes about stupid contexts:
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnComma'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data DataCon
= MkData {
dcName :: Name, -- This is the name of the *source data con*
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index 714eff5273..3bb9a32a50 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -1218,7 +1218,7 @@ if you can use one, use it."
Should this logic only work when *all* candidates have the incoherent flag, or
even when all but one have it? The right choice is the latter, which can be
justified by comparing the behaviour with how -XIncoherentInstances worked when
-it was only about the unify-check (note [Overlapping instances]):
+it was only about the unify-check (Note [Overlapping instances]):
Example:
class C a b c where foo :: (a,b,c)
diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs
index d8d9749941..c551227486 100644
--- a/compiler/GHC/Core/Opt/CallArity.hs
+++ b/compiler/GHC/Core/Opt/CallArity.hs
@@ -170,7 +170,7 @@ The interesting cases of the analysis:
Tricky.
We assume that it is really mutually recursive, i.e. that every variable
calls one of the others, and that this is strongly connected (otherwise we
- return an over-approximation, so that's ok), see note [Recursion and fixpointing].
+ return an over-approximation, so that's ok), see Note [Recursion and fixpointing].
Let V = {v₁,...vₙ}.
Assume that the vs have been analysed with an incoming demand and
@@ -567,7 +567,7 @@ callArityBind boring_vars ae_body int (NonRec v rhs)
-- (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr safe_arity])
(final_ae, NonRec v' rhs')
where
- is_thunk = not (exprIsCheap rhs) -- see note [What is a thunk]
+ is_thunk = not (exprIsCheap rhs) -- see Note [What is a thunk]
-- If v is boring, we will not find it in ae_body, but always assume (0, False)
boring = v `elemVarSet` boring_vars
@@ -637,7 +637,7 @@ callArityBind boring_vars ae_body int b@(Rec binds)
| otherwise
-- We previously analyzed this with a different arity (or not at all)
- = let is_thunk = not (exprIsCheap rhs) -- see note [What is a thunk]
+ = let is_thunk = not (exprIsCheap rhs) -- see Note [What is a thunk]
safe_arity | is_thunk = 0 -- See Note [Thunks in recursive groups]
| otherwise = new_arity
diff --git a/compiler/GHC/Core/Opt/Exitify.hs b/compiler/GHC/Core/Opt/Exitify.hs
index 7da0a68989..164d7119f4 100644
--- a/compiler/GHC/Core/Opt/Exitify.hs
+++ b/compiler/GHC/Core/Opt/Exitify.hs
@@ -310,7 +310,7 @@ intersting.
Expressions are interesting when they move an occurrence of a variable outside
the recursive `go` that can benefit from being obviously called once, for example:
- * a local thunk that can then be inlined (see example in note [Exitification])
+ * a local thunk that can then be inlined (see example in Note [Exitification])
* the parameter of a function, where the demand analyzer then can then
see that it is called at most once, and hence improve the function’s
strictness signature
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 0a2b7a7929..bfabae9f51 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -2471,7 +2471,7 @@ instance Outputable OccEncl where
ppr OccScrut = text "occScrut"
ppr OccVanilla = text "occVanilla"
--- See note [OneShots]
+-- See Note [OneShots]
type OneShots = [OneShotInfo]
initOccEnv :: OccEnv
@@ -2758,7 +2758,7 @@ binding x = cb. See #5028.
NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier
doesn't use it. So this is only to satisfy the perhaps-over-picky Lint.
-Historical note [no-case-of-case]
+Historical Note [no-case-of-case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We *used* to suppress the binder-swap in case expressions when
-fno-case-of-case is on. Old remarks:
@@ -2773,7 +2773,7 @@ We *used* to suppress the binder-swap in case expressions when
However, now the full-laziness pass itself reverses the binder-swap, so this
check is no longer necessary.
-Historical note [Suppressing the case binder-swap]
+Historical Note [Suppressing the case binder-swap]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This old note describes a problem that is also fixed by doing the
binder-swap in OccAnal:
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index f6511439ac..62a40fbcb2 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -301,7 +301,7 @@ getCoreToDo logger dflags
runWhen strictness demand_analyser,
runWhen exitification CoreDoExitify,
- -- See note [Placement of the exitification pass]
+ -- See Note [Placement of the exitification pass]
runWhen full_laziness $
CoreDoFloatOutwards FloatOutSwitches {
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index b1112be288..4f5ece8fca 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -216,7 +216,7 @@ simplTopBinds env0 binds0
-- so that if a rewrite rule has unexpectedly brought
-- anything into scope, then we don't get a complaint about that.
-- It's rather as if the top-level binders were imported.
- -- See note [Glomming] in "GHC.Core.Opt.OccurAnal".
+ -- See Note [Glomming] in "GHC.Core.Opt.OccurAnal".
-- See Note [Bangs in the Simplifier]
; !env1 <- {-#SCC "simplTopBinds-simplRecBndrs" #-} simplRecBndrs env0 (bindersOfBinds binds0)
; (floats, env2) <- {-#SCC "simplTopBinds-simpl_binds" #-} simpl_binds env1 binds0
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index b5f248a250..93ab0608a8 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -400,7 +400,7 @@ lookupRule opts rule_env@(in_scope,_) is_active fn args rules
where
rough_args = map roughTopName args
- -- Strip ticks from arguments, see note [Tick annotations in RULE
+ -- Strip ticks from arguments, see Note [Tick annotations in RULE
-- matching]. We only collect ticks if a rule actually matches -
-- this matters for performance tests.
args' = map (stripTicksTopE tickishFloatable) args
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index feb9efb5f7..80a8277283 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -335,7 +335,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs)
<> semi
-- | Generate code to initialise info pointer origin
--- See note [Mapping Info Tables to Source Positions]
+-- See Note [Mapping Info Tables to Source Positions]
ipInitCode
:: Bool -- is Opt_InfoTableMap enabled or not
-> Platform
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b17b0c8d3d..0c4503a085 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -368,7 +368,7 @@ import qualified GHC.LanguageExtensions as LangExt
data IncludeSpecs
= IncludeSpecs { includePathsQuote :: [String]
, includePathsGlobal :: [String]
- -- | See note [Implicit include paths]
+ -- | See Note [Implicit include paths]
, includePathsQuoteImplicit :: [String]
}
deriving Show
@@ -387,7 +387,7 @@ addQuoteInclude spec paths = let f = includePathsQuote spec
in spec { includePathsQuote = f ++ paths }
-- | These includes are not considered while fingerprinting the flags for iface
--- | See note [Implicit include paths]
+-- | See Note [Implicit include paths]
addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs
addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec
in spec { includePathsQuoteImplicit = f ++ paths }
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index fc50346b21..0045588eaf 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -89,7 +89,7 @@ data HsModule
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'
-- ,'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
hsmodImports :: [LImportDecl GhcPs],
-- ^ We snaffle interesting stuff out of the imported interfaces early
-- on, adding that info to TyDecls/etc; so this list is often empty,
@@ -103,14 +103,14 @@ data HsModule
-- ,'GHC.Parser.Annotation.AnnClose'
--
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
hsmodHaddockModHeader :: Maybe LHsDocString
-- ^ Haddock module info and description, unparsed
--
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'
-- ,'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
}
-- ^ 'GHC.Parser.Annotation.AnnKeywordId's
--
@@ -120,7 +120,7 @@ data HsModule
-- 'GHC.Parser.Annotation.AnnClose' for explicit braces and semi around
-- hsmodImports,hsmodDecls if this style is used.
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
deriving instance Data HsModule
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 8c77966e18..704dc70b02 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -174,7 +174,7 @@ data RecordUpdTc = RecordUpdTc
-- For a data family, these are the type args of the
-- /representation/ type constructor
- , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
+ , rupd_wrap :: HsWrapper -- See Note [Record Update HsWrapper]
}
-- | HsWrap appears only in typechecker output
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 4bc0fc9d4a..fa16da9fdc 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -51,7 +51,7 @@ type LImportDecl pass = XRec pass (ImportDecl pass)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
type instance Anno (ImportDecl (GhcPass p)) = SrcSpanAnnA
-- | If/how an import is 'qualified'.
@@ -111,7 +111,7 @@ data ImportDecl pass
-- 'GHC.Parser.Annotation.AnnClose' attached
-- to location in ideclHiding
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
type family ImportDeclPkgQual pass
type instance ImportDeclPkgQual GhcPs = RawPkgQual
@@ -219,7 +219,7 @@ data IEWrappedName name
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType',
-- 'GHC.Parser.Annotation.AnnPattern'
type LIEWrappedName name = LocatedA (IEWrappedName name)
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Located Import or Export
@@ -228,7 +228,7 @@ type LIE pass = XRec pass (IE pass)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
type instance Anno (IE (GhcPass p)) = SrcSpanAnnA
-- | Imported or exported entity.
@@ -243,7 +243,7 @@ data IE pass
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern',
-- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
| IEThingAll (XIEThingAll pass) (LIEWrappedName (IdP pass))
-- ^ Imported or exported Thing with All imported or exported
@@ -254,7 +254,7 @@ data IE pass
-- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose',
-- 'GHC.Parser.Annotation.AnnType'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- See Note [Located RdrNames] in GHC.Hs.Expr
| IEThingWith (XIEThingWith pass)
@@ -270,7 +270,7 @@ data IE pass
-- 'GHC.Parser.Annotation.AnnComma',
-- 'GHC.Parser.Annotation.AnnType'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName)
-- ^ Imported or exported module contents
--
@@ -278,7 +278,7 @@ data IE pass
--
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| IEGroup (XIEGroup pass) Int HsDocString -- ^ Doc section heading
| IEDoc (XIEDoc pass) HsDocString -- ^ Some documentation
| IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 6fdd87a0e3..f6d718b222 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -462,7 +462,7 @@ repTyClD (L loc (FamDecl { tcdFam = fam })) = liftM Just $
repFamilyDecl (L loc fam)
repTyClD (L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
- = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
+ = do { tc1 <- lookupLOcc tc -- See Note [Binders and occurrences]
; dec <- addTyClTyVarBinds tvs $ \bndrs ->
repSynDecl tc1 bndrs rhs
; return (Just (locA loc, dec)) }
@@ -470,7 +470,7 @@ repTyClD (L loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
repTyClD (L loc (DataDecl { tcdLName = tc
, tcdTyVars = tvs
, tcdDataDefn = defn }))
- = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
+ = do { tc1 <- lookupLOcc tc -- See Note [Binders and occurrences]
; dec <- addTyClTyVarBinds tvs $ \bndrs ->
repDataDefn tc1 (Left bndrs) defn
; return (Just (locA loc, dec)) }
@@ -479,7 +479,7 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
tcdTyVars = tvs, tcdFDs = fds,
tcdSigs = sigs, tcdMeths = meth_binds,
tcdATs = ats, tcdATDefs = atds }))
- = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences]
+ = do { cls1 <- lookupLOcc cls -- See Note [Binders and occurrences]
; dec <- addQTyVarBinds tvs $ \bndrs ->
do { cxt1 <- repLContext cxt
-- See Note [Scoped type variables in quotes]
@@ -551,7 +551,7 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo = info
, fdTyVars = tvs
, fdResultSig = L _ resultSig
, fdInjectivityAnn = injectivity }))
- = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
+ = do { tc1 <- lookupLOcc tc -- See Note [Binders and occurrences]
; let mkHsQTvs :: [LHsTyVarBndr () GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs tvs = HsQTvs { hsq_ext = []
, hsq_explicit = tvs }
@@ -694,7 +694,7 @@ repTyFamEqn (FamEqn { feqn_tycon = tc_name
, feqn_pats = tys
, feqn_fixity = fixity
, feqn_rhs = rhs })
- = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences]
+ = do { tc <- lookupLOcc tc_name -- See Note [Binders and occurrences]
; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs ->
do { tys1 <- case fixity of
Prefix -> repTyArgs (repNamedTyCon tc) tys
@@ -725,7 +725,7 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn =
, feqn_pats = tys
, feqn_fixity = fixity
, feqn_rhs = defn }})
- = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences]
+ = do { tc <- lookupLOcc tc_name -- See Note [Binders and occurrences]
; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs ->
do { tys1 <- case fixity of
Prefix -> repTyArgs (repNamedTyCon tc) tys
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index dc358d1c2d..ace07c5977 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -48,7 +48,7 @@ fingerprintDynFlags hsc_env this_mod nameio =
map fromEnum $ EnumSet.toList extensionFlags)
-- avoid fingerprinting the absolute path to the directory of the source file
- -- see note [Implicit include paths]
+ -- see Note [Implicit include paths]
includePathsMinusImplicit = includePaths { includePathsQuoteImplicit = [] }
-- -I, -D and -U flags affect CPP
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index f21dd7f9f4..28c2cbc54d 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -1264,7 +1264,7 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
`setArityInfo` arity
`setDmdSigInfo` final_sig
`setCprSigInfo` final_cpr
- `setUnfoldingInfo` minimal_unfold_info -- See note [Preserve evaluatedness]
+ `setUnfoldingInfo` minimal_unfold_info -- See Note [Preserve evaluatedness]
-- in GHC.Core.Tidy
| otherwise -- Externally-visible Ids get the whole lot
diff --git a/compiler/GHC/Iface/Type.hs-boot b/compiler/GHC/Iface/Type.hs-boot
index 2d896350a2..c840f9af51 100644
--- a/compiler/GHC/Iface/Type.hs-boot
+++ b/compiler/GHC/Iface/Type.hs-boot
@@ -5,7 +5,7 @@ module GHC.Iface.Type
where
-- Empty import to influence the compilation ordering.
--- See note [Depend on GHC.Integer] in GHC.Base
+-- See Note [Depend on GHC.Integer] in GHC.Base
import GHC.Base ()
data IfaceAppArgs
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 0265cc4ce2..1f48615aec 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -196,7 +196,7 @@ https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
--
-- Note: in general the names of these are taken from the
-- corresponding token, unless otherwise noted
--- See note [exact print annotations] above for details of the usage
+-- See Note [exact print annotations] above for details of the usage
data AnnKeywordId
= AnnAnyclass
| AnnAs
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 588d6692a9..7bcff45ed8 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -756,7 +756,7 @@ data Token
| ITdependency
| ITrequires
- -- Pragmas, see note [Pragma source text] in "GHC.Types.Basic"
+ -- Pragmas, see Note [Pragma source text] in "GHC.Types.Basic"
| ITinline_prag SourceText InlineSpec RuleMatchInfo
| ITspec_prag SourceText -- SPECIALISE
| ITspec_inline_prag SourceText Bool -- SPECIALISE INLINE (or NOINLINE)
@@ -2379,7 +2379,7 @@ data PState = PState {
-- The next three are used to implement Annotations giving the
-- locations of 'noise' tokens in the source, so that users of
-- the GHC API can do source to source conversions.
- -- See note [exact print annotations] in GHC.Parser.Annotation
+ -- See Note [exact print annotations] in GHC.Parser.Annotation
eof_pos :: Strict.Maybe (Strict.Pair RealSrcSpan RealSrcSpan), -- pos, gap to prior token
header_comments :: Strict.Maybe [LEpaComment],
comment_q :: [LEpaComment],
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 83b55f5632..a04eba73a4 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -922,7 +922,7 @@ mkRuleTyVarBndrs = fmap cvt_one
tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)
tm_to_ty _ = panic "mkRuleTyVarBndrs"
--- See note [Parsing explicit foralls in Rules] in Parser.y
+-- See Note [Parsing explicit foralls in Rules] in Parser.y
checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P ()
checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
where check (L loc (Unqual occ)) =
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 2062b2e23a..0f78a86b57 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -422,7 +422,7 @@ rnPats ctxt pats thing_inside
-- Nor can we check incrementally for shadowing, else we'll
-- complain *twice* about duplicates e.g. f (x,x) = ...
--
- -- See note [Don't report shadowing for pattern synonyms]
+ -- See Note [Don't report shadowing for pattern synonyms]
; let bndrs = collectPatsBinders CollNoDictBinders pats'
; addErrCtxt doc_pat $
if isPatSynCtxt ctxt
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 5774698375..5bbc2927ab 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -320,7 +320,7 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
(helpful_imports_hiding, helpful_imports_non_hiding)
= partition (imv_is_hiding . snd) helpful_imports
- -- See note [When to show/hide the module-not-imported line]
+ -- See Note [When to show/hide the module-not-imported line]
show_not_imported_line :: ModuleName -> Bool -- #15611
show_not_imported_line modnam
| modnam `elem` glob_mods = False -- #14225 -- 1
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs
index 01d1c4b518..8062337192 100644
--- a/compiler/GHC/Stg/CSE.hs
+++ b/compiler/GHC/Stg/CSE.hs
@@ -11,8 +11,8 @@ their types differ.
This was originally reported as #9291.
There are two types of common code occurrences that we aim for, see
-note [Case 1: CSEing allocated closures] and
-note [Case 2: CSEing case binders] below.
+Note [Case 1: CSEing allocated closures] and
+Note [Case 2: CSEing case binders] below.
Note [Case 1: CSEing allocated closures]
@@ -147,7 +147,7 @@ instance TrieMap ConAppMap where
-- The CSE Env --
-----------------
--- | The CSE environment. See note [CseEnv Example]
+-- | The CSE environment. See Note [CseEnv Example]
data CseEnv = CseEnv
{ ce_conAppMap :: ConAppMap OutId
-- ^ The main component of the environment is the trie that maps
@@ -245,7 +245,7 @@ addDataCon bndr dataCon args env
-------------------
forgetCse :: CseEnv -> CseEnv
forgetCse env = env { ce_conAppMap = emptyTM }
- -- See note [Free variables of an StgClosure]
+ -- See Note [Free variables of an StgClosure]
addSubst :: OutId -> OutId -> CseEnv -> CseEnv
addSubst from to env
@@ -387,7 +387,7 @@ stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs)
= addDataCon case_bndr dataCon (map StgVarArg args') env1
| otherwise
= env1
- -- see note [Case 2: CSEing case binders]
+ -- see Note [Case 2: CSEing case binders]
rhs' = stgCseExpr env2 rhs
in (DataAlt dataCon, args', rhs')
stgCseAlt env _ _ (altCon, args, rhs)
@@ -427,14 +427,14 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon mu ticks args)
in (Nothing, env')
| otherwise
= let env' = addDataCon bndr dataCon args' env
- -- see note [Case 1: CSEing allocated closures]
+ -- see Note [Case 1: CSEing allocated closures]
pair = (bndr, StgRhsCon ccs dataCon mu ticks args')
in (Just pair, env')
where args' = substArgs env args
stgCseRhs env bndr (StgRhsClosure ext ccs upd args body)
= let (env1, args') = substBndrs env args
- env2 = forgetCse env1 -- See note [Free variables of an StgClosure]
+ env2 = forgetCse env1 -- See Note [Free variables of an StgClosure]
body' = stgCseExpr env2 body
in (Just (substVar env bndr, StgRhsClosure ext ccs upd args' body'), env)
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 7107370698..3f935c848d 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -92,7 +92,7 @@ cgTopRhsClosure platform rec id ccs upd_flag args body =
-- shortcutting the whole process, and generating a lot less code
-- (#7308). Eventually the IND_STATIC closure will be eliminated
-- by assembly '.equiv' directives, where possible (#15155).
- -- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
+ -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
--
-- Note: we omit the optimisation when this binding is part of a
-- recursive group, because the optimisation would inhibit the black
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index ff80c9eda2..d82c9f6ff4 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -810,10 +810,10 @@ cgAlts _ _ _ _ = panic "cgAlts"
-- tricky part is that the default case needs (logical) duplication.
-- To do this we emit an extra label for it and branch to that from
-- the second switch. This avoids duplicated codegen. See Trac #14373.
--- See note [Double switching for big families] for the mechanics
+-- See Note [Double switching for big families] for the mechanics
-- involved.
--
--- Also see note [Data constructor dynamic tags]
+-- Also see Note [Data constructor dynamic tags]
-- and the wiki https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/haskell-execution/pointer-tagging
--
diff --git a/compiler/GHC/SysTools/BaseDir.hs b/compiler/GHC/SysTools/BaseDir.hs
index 5d86ee6925..54c42e7c52 100644
--- a/compiler/GHC/SysTools/BaseDir.hs
+++ b/compiler/GHC/SysTools/BaseDir.hs
@@ -19,7 +19,7 @@ module GHC.SysTools.BaseDir
import GHC.Prelude
--- See note [Base Dir] for why some of this logic is shared with ghc-pkg.
+-- See Note [Base Dir] for why some of this logic is shared with ghc-pkg.
import GHC.BaseDir
import GHC.Utils.Panic
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index b5a7c5a7b2..0f0abcd71d 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -432,7 +432,7 @@ tcArrDoStmt env ctxt (RecStmt { recS_stmts = L l stmts, recS_later_ids = later_n
-- NB: The rec_ids for the recursive things
-- already scope over this part. This binding may shadow
-- some of them with polymorphic things with the same Name
- -- (see note [RecStmt] in GHC.Hs.Expr)
+ -- (see Note [RecStmt] in GHC.Hs.Expr)
; let rec_ids = takeList rec_names tup_ids
; later_ids <- tcLookupLocalIds later_names
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 40a3732a0e..2055b3101c 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -573,7 +573,7 @@ lookupChildrenExport spec_parent rdr_items =
-- | Given a resolved name in the children export list and a parent. Decide
-- whether we are allowed to export the child with the parent.
-- Invariant: gre_par == NoParent
--- See note [Typing Pattern Synonym Exports]
+-- See Note [Typing Pattern Synonym Exports]
checkPatSynParent :: Name -- ^ Alleged parent type constructor
-- User wrote T( P, Q )
-> Parent -- The parent of P we discovered
@@ -612,7 +612,7 @@ checkPatSynParent parent NoParent gname
-> TcM ()
handle_pat_syn doc ty_con pat_syn
- -- 2. See note [Types of TyCon]
+ -- 2. See Note [Types of TyCon]
| not $ isTyConWithSrcDataCons ty_con
= addErrCtxt doc $ failWithTc TcRnPatSynBundledWithNonDataCon
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 8bff4b7e53..230acdc3f5 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -685,7 +685,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left rbnds }) res_
not (isRecordSelector sel_id),
let fld_name = idName sel_id ]
; unless (null bad_guys) (sequence bad_guys >> failM)
- -- See note [Mixed Record Selectors]
+ -- See Note [Mixed Record Selectors]
; let (data_sels, pat_syn_sels) =
partition isDataConRecordSelector sel_ids
; massert (all isPatSynRecordSelector pat_syn_sels)
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index cf566bdcf9..2a3ef6fd10 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -2362,7 +2362,7 @@ kcCheckDeclHeader_cusk name flav
(HsQTvs { hsq_ext = kv_ns
, hsq_explicit = hs_tvs }) kc_res_ki
-- CUSK case
- -- See note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl
+ -- See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl
= addTyConFlavCtxt name flav $
do { skol_info <- mkSkolemInfo skol_info_anon
; (tclvl, wanted, (scoped_kvs, (tc_tvs, res_kind)))
@@ -2452,7 +2452,7 @@ kcInferDeclHeader name flav
(HsQTvs { hsq_ext = kv_ns
, hsq_explicit = hs_tvs }) kc_res_ki
-- No standalane kind signature and no CUSK.
- -- See note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl
+ -- See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl
= addTyConFlavCtxt name flav $
do { (scoped_kvs, (tc_tvs, res_kind))
-- Why bindImplicitTKBndrs_Q_Tv which uses newTyVarTyVar?
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 121b4b2d94..6034d05720 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -325,7 +325,7 @@ tcMultiple tc_pat penv args thing_inside
setErrCtxt err_ctxt $
loop penv args
-- setErrCtxt: restore context before doing the next pattern
- -- See note [Nesting] above
+ -- See Note [Nesting] above
; return (p':ps', res) }
diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs
index 59db2bd3ae..8c855dacbc 100644
--- a/compiler/GHC/Tc/TyCl/Build.hs
+++ b/compiler/GHC/Tc/TyCl/Build.hs
@@ -326,7 +326,7 @@ buildClass tycon_name binders roles fds
-- i.e. exactly one operation or superclass taken together
-- (b) that value is of lifted type (which they always are, because
-- we box equality superclasses)
- -- See note [Class newtypes and equality predicates]
+ -- See Note [Class newtypes and equality predicates]
-- We treat the dictionary superclasses as ordinary arguments.
-- That means that in the case of
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 3a0fdca51a..c510d29f63 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -1971,7 +1971,7 @@ skolemiseUnboundMetaTyVar skol_info tv
; return final_tv }
where
check_empty tv -- [Sept 04] Check for non-empty.
- = when debugIsOn $ -- See note [Silly Type Synonym]
+ = when debugIsOn $ -- See Note [Silly Type Synonym]
do { cts <- readMetaTyVar tv
; case cts of
Flexi -> return ()
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 363ece84b2..ae35cea3a2 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -1804,7 +1804,7 @@ pickQuantifiablePreds qtvs theta
-> Nothing
| isIPClass cls
- -> Just pred -- See note [Inheriting implicit parameters]
+ -> Just pred -- See Note [Inheriting implicit parameters]
| pick_cls_pred flex_ctxt cls tys
-> Just pred
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 0e160ad269..e7c384d0a4 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -593,7 +593,7 @@ instance Outputable Origin where
-- @'\{-\# INCOHERENT'@,
-- 'GHC.Parser.Annotation.AnnClose' @`\#-\}`@,
--- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
+-- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"
data OverlapFlag = OverlapFlag
{ overlapMode :: OverlapMode
, isSafeOverlap :: Bool
@@ -677,7 +677,7 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
-- instance Foo [a]
-- Without the Incoherent flag, we'd complain that
-- instantiating 'b' would change which instance
- -- was chosen. See also note [Incoherent instances] in "GHC.Core.InstEnv"
+ -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv"
deriving (Eq, Data)
@@ -1240,7 +1240,7 @@ instance Outputable CompilerPhase where
ppr InitialPhase = text "InitialPhase"
ppr FinalPhase = text "FinalPhase"
--- See note [Pragma source text]
+-- See Note [Pragma source text]
data Activation
= AlwaysActive
| ActiveBefore SourceText PhaseNum -- Active only *strictly before* this phase
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
index 0c9032af91..1ad35af232 100644
--- a/compiler/GHC/Types/ForeignCall.hs
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -99,7 +99,7 @@ playInterruptible _ = False
data CExportSpec
= CExportStatic -- foreign export ccall foo :: ty
SourceText -- of the CLabelString.
- -- See note [Pragma source text] in GHC.Types.SourceText
+ -- See Note [Pragma source text] in GHC.Types.SourceText
CLabelString -- C Name of exported function
CCallConv
deriving Data
@@ -117,7 +117,7 @@ data CCallTarget
-- An "unboxed" ccall# to named function in a particular package.
= StaticTarget
SourceText -- of the CLabelString.
- -- See note [Pragma source text] in GHC.Types.SourceText
+ -- See Note [Pragma source text] in GHC.Types.SourceText
CLabelString -- C-land name of label.
(Maybe Unit) -- What package the function is in.
@@ -241,7 +241,7 @@ instance Outputable Header where
-- 'GHC.Parser.Annotation.AnnHeader','GHC.Parser.Annotation.AnnVal',
-- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@,
--- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
+-- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"
data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.SourceText
(Maybe Header) -- header to include for this type
(SourceText,FastString) -- the type itself
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 05ea5a696b..55005e4129 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -124,7 +124,7 @@ import GHC.Data.Bag
-- 'GHC.Parser.Annotation.AnnVal'
-- 'GHC.Parser.Annotation.AnnTilde',
--- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
+-- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"
data RdrName
= Unqual OccName
-- ^ Unqualified name
diff --git a/compiler/GHC/Types/TyThing.hs b/compiler/GHC/Types/TyThing.hs
index ad57abf773..8a12506a63 100644
--- a/compiler/GHC/Types/TyThing.hs
+++ b/compiler/GHC/Types/TyThing.hs
@@ -139,7 +139,7 @@ Examples:
-- names returned by 'GHC.Iface.Load.ifaceDeclImplicitBndrs', in the sense that
-- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in 'GHC.IfaceToCore.tc_iface_decl_fingerprint' (see
--- note [Tricky iface loop])
+-- Note [Tricky iface loop])
-- The order of the list does not matter.
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings (AnId _) = []
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index e3e611674c..eb3697d505 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -201,7 +201,7 @@ data HsBindLR idL idR
-- - 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
FunBind {
fun_ext :: XFunBind idL idR,
@@ -242,7 +242,7 @@ data HsBindLR idL idR
-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnWhere',
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| PatBind {
pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars]
pat_lhs :: LPat idL,
@@ -293,7 +293,7 @@ data HsBindLR idL idR
-- 'GHC.Parser.Annotation.AnnWhere'
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XHsBindsLR !(XXHsBindsLR idL idR)
@@ -327,7 +327,7 @@ data ABExport p
-- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@,
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Pattern Synonym binding
data PatSynBind idL idR
@@ -597,7 +597,7 @@ type LIPBind id = XRec id (IPBind id)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a
-- list
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Implicit parameter bindings.
--
@@ -608,7 +608,7 @@ type LIPBind id = XRec id (IPBind id)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data IPBind id
= IPBind
(XCIPBind id)
@@ -649,7 +649,7 @@ data Sig pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon',
-- 'GHC.Parser.Annotation.AnnComma'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
TypeSig
(XTypeSig pass)
[LIdP pass] -- LHS of the signature; e.g. f,g,h :: blah
@@ -663,7 +663,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnForall'
-- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| PatSynSig (XPatSynSig pass) [LIdP pass] (LHsSigType pass)
-- P :: forall a b. Req => Prov => ty
@@ -694,7 +694,7 @@ data Sig pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnInfix',
-- 'GHC.Parser.Annotation.AnnVal'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| FixSig (XFixSig pass) (FixitySig pass)
-- | An inline pragma
@@ -707,7 +707,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnVal','GHC.Parser.Annotation.AnnTilde',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| InlineSig (XInlineSig pass)
(LIdP pass) -- Function name
InlinePragma -- Never defaultInlinePragma
@@ -723,7 +723,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnClose' @']'@ and @'\#-}'@,
-- 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SpecSig (XSpecSig pass)
(LIdP pass) -- Specialise a function or datatype ...
[LHsSigType pass] -- ... to these types
@@ -741,7 +741,7 @@ data Sig pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
-- Note [Pragma source text] in GHC.Types.SourceText
@@ -753,7 +753,7 @@ data Sig pass
-- 'GHC.Parser.Annotation.AnnVbar','GHC.Parser.Annotation.AnnComma',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| MinimalSig (XMinimalSig pass)
SourceText (LBooleanFormula (LIdP pass))
-- Note [Pragma source text] in GHC.Types.SourceText
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 410d709bec..fbeebf9213 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -133,7 +133,7 @@ type LHsDecl p = XRec p (HsDecl p)
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
--
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | A Haskell Declaration
data HsDecl p
@@ -401,7 +401,7 @@ data TyClDecl pass
-- 'GHC.Parser.Annotation.AnnEqual','GHC.Parser.Annotation.AnnRarrow',
-- 'GHC.Parser.Annotation.AnnVbar'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
| -- | @type@ declaration
@@ -409,7 +409,7 @@ data TyClDecl pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
-- 'GHC.Parser.Annotation.AnnEqual',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
SynDecl { tcdSExt :: XSynDecl pass -- ^ Post renameer, FVs
, tcdLName :: LIdP pass -- ^ Type constructor
, tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an
@@ -426,7 +426,7 @@ data TyClDecl pass
-- 'GHC.Parser.Annotation.AnnNewType','GHC.Parser.Annotation.AnnDcolon'
-- 'GHC.Parser.Annotation.AnnWhere',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs
, tcdLName :: LIdP pass -- ^ Type constructor
, tcdTyVars :: LHsQTyVars pass -- ^ Type variables
@@ -453,7 +453,7 @@ data TyClDecl pass
-- 'GHC.Parser.Annotation.AnnComma'
-- 'GHC.Parser.Annotation.AnnRarrow'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XTyClDecl !(XXTyClDecl pass)
data FunDep pass
@@ -798,14 +798,14 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
NoSig (XNoSig pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| KindSig (XCKindSig pass) (LHsKind pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
-- 'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon',
-- 'GHC.Parser.Annotation.AnnCloseP'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| TyVarSig (XTyVarSig pass) (LHsTyVarBndr () pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
@@ -813,7 +813,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
-- 'GHC.Parser.Annotation.AnnCloseP', 'GHC.Parser.Annotation.AnnEqual'
| XFamilyResultSig !(XXFamilyResultSig pass)
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Located type Family Declaration
@@ -839,7 +839,7 @@ data FamilyDecl pass = FamilyDecl
-- 'GHC.Parser.Annotation.AnnEqual', 'GHC.Parser.Annotation.AnnRarrow',
-- 'GHC.Parser.Annotation.AnnVbar'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Located Injectivity Annotation
@@ -859,7 +859,7 @@ data InjectivityAnn pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' :
-- 'GHC.Parser.Annotation.AnnRarrow', 'GHC.Parser.Annotation.AnnVbar'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XInjectivityAnn !(XXInjectivityAnn pass)
data FamilyInfo pass
@@ -919,7 +919,7 @@ data HsDataDefn pass -- The payload of a data type defn
dd_derivs :: HsDeriving pass -- ^ Optional 'deriving' clause
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
}
| XHsDataDefn !(XXHsDataDefn pass)
@@ -1022,7 +1022,7 @@ type LConDecl pass = XRec pass (ConDecl pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when
-- in a GADT constructor list
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- |
--
@@ -1046,7 +1046,7 @@ type LConDecl pass = XRec pass (ConDecl pass)
-- 'GHC.Parser.Annotation.AnnDarrow','GHC.Parser.Annotation.AnnDarrow',
-- 'GHC.Parser.Annotation.AnnForall','GHC.Parser.Annotation.AnnDot'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | data Constructor Declaration
data ConDecl pass
@@ -1258,7 +1258,7 @@ type LTyFamInstEqn pass = XRec pass (TyFamInstEqn pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
-- when in a list
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Haskell Type Patterns
type HsTyPats pass = [LHsTypeArg pass]
@@ -1318,7 +1318,7 @@ data TyFamInstDecl pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
-- 'GHC.Parser.Annotation.AnnInstance',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XTyFamInstDecl !(XXTyFamInstDecl pass)
----------------- Data family instances -------------
@@ -1336,7 +1336,7 @@ newtype DataFamInstDecl pass
-- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
----------------- Family instances (common types) -------------
@@ -1359,7 +1359,7 @@ data FamEqn pass rhs
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
| XFamEqn !(XXFamEqn pass rhs)
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
----------------- Class instances -------------
@@ -1381,14 +1381,14 @@ data ClsInstDecl pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
}
-- ^
-- - '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 [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XClsInstDecl !(XXClsInstDecl pass)
----------------- Instances of all kinds -------------
@@ -1442,7 +1442,7 @@ data DerivDecl pass = DerivDecl
-- 'GHC.Parser.Annotation.AnnAnyClass', 'GHC.Parser.Annotation.AnnNewtype',
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
}
| XDerivDecl !(XXDerivDecl pass)
@@ -1501,7 +1501,7 @@ data DefaultDecl pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnDefault',
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XDefaultDecl !(XXDefaultDecl pass)
{-
@@ -1539,7 +1539,7 @@ data ForeignDecl pass
-- 'GHC.Parser.Annotation.AnnImport','GHC.Parser.Annotation.AnnExport',
-- 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XForeignDecl !(XXForeignDecl pass)
{-
@@ -1689,7 +1689,7 @@ data RuleBndr pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
@@ -1775,7 +1775,7 @@ data AnnDecl pass = HsAnnotation
-- 'GHC.Parser.Annotation.AnnModule'
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XAnnDecl !(XXAnnDecl pass)
-- | Annotation Provenance
@@ -1813,5 +1813,5 @@ data RoleAnnotDecl pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
-- 'GHC.Parser.Annotation.AnnRole'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XRoleAnnotDecl !(XXRoleAnnotDecl pass)
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 0baaeaa148..418aa59f84 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -192,7 +192,7 @@ type LHsExpr p = XRec p (HsExpr p)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-------------------------
{- Note [NoSyntaxExpr]
@@ -359,7 +359,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
-- 'GHC.Parser.Annotation.AnnRarrow',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
--
@@ -367,7 +367,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsApp (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
@@ -396,7 +396,7 @@ data HsExpr p
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| NegApp (XNegApp p)
(LHsExpr p)
(SyntaxExpr p)
@@ -404,7 +404,7 @@ data HsExpr p
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsPar (XPar p)
!(LHsToken "(" p)
(LHsExpr p) -- ^ Parenthesised expr; see Note [Parens in HsSyn]
@@ -422,7 +422,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- Note [ExplicitTuple]
| ExplicitTuple
(XExplicitTuple p)
@@ -446,7 +446,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCase (XCase p)
(LHsExpr p)
(MatchGroup p (LHsExpr p))
@@ -456,7 +456,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',
-- 'GHC.Parser.Annotation.AnnElse',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsIf (XIf p) -- GhcPs: this is a Bool; False <=> do not use
-- rebindable syntax
(LHsExpr p) -- predicate
@@ -468,7 +468,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnIf'
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)]
-- | let(rec)
@@ -477,7 +477,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsLet (XLet p)
!(LHsToken "let" p)
(HsLocalBinds p)
@@ -489,7 +489,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnVbar',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsDo (XDo p) -- Type of the whole expression
HsDoFlavour
(XRec p [ExprLStmt p]) -- "do":one or more stmts
@@ -499,7 +499,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
-- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- See Note [Empty lists]
| ExplicitList
(XExplicitList p) -- Gives type of components of list
@@ -510,7 +510,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| RecordCon
{ rcon_ext :: XRecordCon p
, rcon_con :: XRec p (ConLikeP p) -- The constructor
@@ -523,7 +523,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnComma, 'GHC.Parser.Annotation.AnnDot',
-- 'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| RecordUpd
{ rupd_ext :: XRecordUpd p
, rupd_expr :: LHsExpr p
@@ -536,7 +536,7 @@ data HsExpr p
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDot'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- This case only arises when the OverloadedRecordDot langauge
-- extension is enabled. See Note [Record Selectors in the AST].
@@ -554,7 +554,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenP'
-- 'GHC.Parser.Annotation.AnnDot', 'GHC.Parser.Annotation.AnnCloseP'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsProjection {
proj_ext :: XProjection p
, proj_flds :: NonEmpty (XRec p (DotFieldOcc p))
@@ -564,7 +564,7 @@ data HsExpr p
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ExprWithTySig
(XExprWithTySig p)
@@ -577,14 +577,14 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnComma','GHC.Parser.Annotation.AnnDotdot',
-- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ArithSeq
(XArithSeq p)
(Maybe (SyntaxExpr p))
-- For OverloadedLists, the fromList witness
(ArithSeqInfo p)
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-----------------------------------------------------------
-- MetaHaskell Extensions
@@ -593,7 +593,7 @@ data HsExpr p
-- 'GHC.Parser.Annotation.AnnOpenE','GHC.Parser.Annotation.AnnOpenEQ',
-- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnCloseQ'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsBracket (XBracket p) (HsBracket p)
-- See Note [Pending Splices]
@@ -615,7 +615,7 @@ data HsExpr p
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsSpliceE (XSpliceE p) (HsSplice p)
-----------------------------------------------------------
@@ -626,7 +626,7 @@ data HsExpr p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnProc',
-- 'GHC.Parser.Annotation.AnnRarrow'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsProc (XProc p)
(LPat p) -- arrow abstraction, proc
(LHsCmdTop p) -- body of the abstraction
@@ -636,7 +636,7 @@ data HsExpr p
-- static pointers extension
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnStatic',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsStatic (XStatic p) -- Free variables of the body, and type after typechecking
(LHsExpr p) -- Body
@@ -692,7 +692,7 @@ data HsPragE p
type LHsTupArg id = XRec id (HsTupArg id)
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Haskell Tuple Argument
data HsTupArg id
@@ -881,7 +881,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.Annrarrowtail','GHC.Parser.Annotation.AnnLarrowtail',
-- 'GHC.Parser.Annotation.AnnRarrowtail'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
= HsCmdArrApp -- Arrow tail, or arrow application (f -< arg)
(XCmdArrApp id) -- type of the arrow expressions f,
-- of the form a t t', where arg :: t
@@ -894,7 +894,7 @@ data HsCmd id
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpenB' @'(|'@,
-- 'GHC.Parser.Annotation.AnnCloseB' @'|)'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |)
(XCmdArrForm id)
(LHsExpr id) -- The operator.
@@ -915,7 +915,7 @@ data HsCmd id
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam',
-- 'GHC.Parser.Annotation.AnnRarrow',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdPar (XCmdPar id)
!(LHsToken "(" id)
@@ -924,7 +924,7 @@ data HsCmd id
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdCase (XCmdCase id)
(LHsExpr id)
@@ -933,7 +933,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.AnnOf','GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdLamCase (XCmdLamCase id)
(MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
@@ -941,7 +941,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdIf (XCmdIf id)
(SyntaxExpr id) -- cond function
@@ -953,7 +953,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.AnnThen','GHC.Parser.Annotation.AnnSemi',
-- 'GHC.Parser.Annotation.AnnElse',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdLet (XCmdLet id)
!(LHsToken "let" id)
@@ -964,7 +964,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdDo (XCmdDo id) -- Type of the whole expression
(XRec id [CmdLStmt id])
@@ -973,7 +973,7 @@ data HsCmd id
-- 'GHC.Parser.Annotation.AnnVbar',
-- 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XCmd !(XXCmd id) -- Extension point; see Note [Trees That Grow]
-- in Language.Haskell.Syntax.Extension
@@ -1061,12 +1061,12 @@ type LMatch id body = XRec id (Match id body)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when in a
-- list
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data Match p body
= Match {
m_ext :: XCMatch p body,
m_ctxt :: HsMatchContext p,
- -- See note [m_ctxt in Match]
+ -- See Note [m_ctxt in Match]
m_pats :: [LPat p], -- The patterns
m_grhss :: (GRHSs p body)
}
@@ -1124,7 +1124,7 @@ isInfixMatch match = case m_ctxt match of
-- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose'
-- 'GHC.Parser.Annotation.AnnRarrow','GHC.Parser.Annotation.AnnSemi'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data GRHSs p body
= GRHSs {
grhssExt :: XCGRHSs p body,
@@ -1193,7 +1193,7 @@ type GhciStmt id = Stmt id (LHsExpr id)
-- 'GHC.Parser.Annotation.AnnBy','GHC.Parser.Annotation.AnnBy',
-- 'GHC.Parser.Annotation.AnnGroup','GHC.Parser.Annotation.AnnUsing'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data StmtLR idL idR body -- body should always be (LHs**** idR)
= LastStmt -- Always the last Stmt in ListComp, MonadComp,
-- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr
@@ -1211,7 +1211,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- See Note [Monad Comprehensions]
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLarrow'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| BindStmt (XBindStmt idL idR body)
-- ^ Post renaming has optional fail and bind / (>>=) operator.
-- Post typechecking, also has multiplicity of the argument
@@ -1245,7 +1245,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet'
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@,
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| LetStmt (XLetStmt idL idR body) (HsLocalBindsLR idL idR)
-- ParStmts only occur in a list/monad comprehension
@@ -1283,7 +1283,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- Recursive statement (see Note [How RecStmt works] below)
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRec'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| RecStmt
{ recS_ext :: XRecStmt idL idR body
, recS_stmts :: XRec idR [LStmtLR idL idR body]
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 4393ad998a..2f96d107c0 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -50,7 +50,7 @@ type LPat p = XRec p (Pat p)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data Pat p
= ------------ Simple patterns ---------------
WildPat (XWildPat p) -- ^ Wildcard Pattern
@@ -66,13 +66,13 @@ data Pat p
(LPat p) -- ^ Lazy Pattern
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| AsPat (XAsPat p)
(LIdP p) (LPat p) -- ^ As pattern
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ParPat (XParPat p)
!(LHsToken "(" p)
@@ -82,12 +82,12 @@ data Pat p
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| BangPat (XBangPat p)
(LPat p) -- ^ Bang pattern
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
------------ Lists, tuples, arrays ---------------
| ListPat (XListPat p)
@@ -98,7 +98,7 @@ data Pat p
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
-- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| TuplePat (XTuplePat p)
-- after typechecking, holds the types of the tuple components
@@ -136,7 +136,7 @@ data Pat p
-- 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
-- 'GHC.Parser.Annotation.AnnClose' @'#)'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
------------ Constructor patterns ---------------
| ConPat {
@@ -149,7 +149,7 @@ data Pat p
------------ View patterns ---------------
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ViewPat (XViewPat p)
(LHsExpr p)
(LPat p)
@@ -159,7 +159,7 @@ data Pat p
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SplicePat (XSplicePat p)
(HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
@@ -185,7 +185,7 @@ data Pat p
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| NPlusKPat (XNPlusKPat p) -- Type of overall pattern
(LIdP p) -- n+k pattern
(XRec p (HsOverLit p)) -- It'll always be an HsIntegral
@@ -200,7 +200,7 @@ data Pat p
------------ Pattern type signatures ---------------
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| SigPat (XSigPat p) -- After typechecker: Type
(LPat p) -- Pattern with a type signature
(HsPatSigType (NoGhcTc p)) -- Signature can bind both
@@ -272,7 +272,7 @@ type HsRecUpdField p = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr p)
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',
--
--- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data HsFieldBind lhs rhs = HsFieldBind {
hfbAnn :: XHsFieldBind lhs,
hfbLHS :: lhs,
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 6827438595..173b75c4c2 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -278,7 +278,7 @@ quantified in left-to-right order in kind signatures is nice since:
-- | Located Haskell Context
type LHsContext pass = XRec pass (HsContext pass)
-- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnUnit'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Haskell Context
type HsContext pass = [LHsType pass]
@@ -288,7 +288,7 @@ type LHsType pass = XRec pass (HsType pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Haskell Kind
type HsKind pass = HsType pass
@@ -297,7 +297,7 @@ type HsKind pass = HsType pass
type LHsKind pass = XRec pass (HsKind pass)
-- ^ 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
--------------------------------------------------
-- LHsQTyVars
@@ -710,7 +710,7 @@ data HsTyVarBndr flag pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnDcolon', 'GHC.Parser.Annotation.AnnClose'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XTyVarBndr
!(XXTyVarBndr pass)
@@ -731,7 +731,7 @@ data HsType pass
}
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnForall',
-- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow'
- -- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
+ -- For details on above see Note [exact print annotations] in "GHC.Parser.Annotation"
| HsQualTy -- See Note [HsType binders]
{ hst_xqual :: XQualTy pass
@@ -747,14 +747,14 @@ data HsType pass
-- See Note [Located RdrNames] in GHC.Hs.Expr
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsAppTy (XAppTy pass)
(LHsType pass)
(LHsType pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsAppKindTy (XAppKindTy pass) -- type level type app
(LHsType pass)
@@ -766,14 +766,14 @@ data HsType pass
(LHsType pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow',
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsListTy (XListTy pass)
(LHsType pass) -- Element type
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
-- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsTupleTy (XTupleTy pass)
HsTupleSort
@@ -781,20 +781,20 @@ data HsType pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(' or '(#'@,
-- 'GHC.Parser.Annotation.AnnClose' @')' or '#)'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsSumTy (XSumTy pass)
[LHsType pass] -- Element types (length gives arity)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@,
-- 'GHC.Parser.Annotation.AnnClose' '#)'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsOpTy (XOpTy pass)
(LHsType pass) (LIdP pass) (LHsType pass)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsParTy (XParTy pass)
(LHsType pass) -- See Note [Parens in HsSyn] in GHC.Hs.Expr
@@ -804,7 +804,7 @@ data HsType pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsIParamTy (XIParamTy pass)
(XRec pass HsIPName) -- (?x :: ty)
@@ -815,7 +815,7 @@ data HsType pass
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsStarTy (XStarTy pass)
Bool -- Is this the Unicode variant?
@@ -831,20 +831,20 @@ data HsType pass
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsSpliceTy (XSpliceTy pass)
(HsSplice pass) -- Includes quasi-quotes
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsDocTy (XDocTy pass)
(LHsType pass) LHsDocString -- A documented type
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsBangTy (XBangTy pass)
HsSrcBang (LHsType pass) -- Bang-style type annotations
@@ -853,14 +853,14 @@ data HsType pass
-- 'GHC.Parser.Annotation.AnnClose' @'#-}'@
-- 'GHC.Parser.Annotation.AnnBang' @\'!\'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsRecTy (XRecTy pass)
[LConDeclField pass] -- Only in data type declarations
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@,
-- 'GHC.Parser.Annotation.AnnClose' @'}'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsExplicitListTy -- A promoted explicit list
(XExplicitListTy pass)
@@ -869,7 +869,7 @@ data HsType pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'["@,
-- 'GHC.Parser.Annotation.AnnClose' @']'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsExplicitTupleTy -- A promoted explicit tuple
(XExplicitTupleTy pass)
@@ -877,18 +877,18 @@ data HsType pass
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'("@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsTyLit (XTyLit pass) HsTyLit -- A promoted numeric literal.
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsWildCardTy (XWildCardTy pass) -- A type wildcard
-- See Note [The wildcard story for types]
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension
| XHsType
@@ -1038,7 +1038,7 @@ type LConDeclField pass = XRec pass (ConDeclField pass)
-- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' when
-- in a list
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
-- | Constructor Declaration Field
data ConDeclField pass -- Record fields have Haddock docs on them
@@ -1049,7 +1049,7 @@ data ConDeclField pass -- Record fields have Haddock docs on them
cd_fld_doc :: Maybe LHsDocString }
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'
- -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+ -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| XConDeclField !(XXConDeclField pass)
-- | Describes the arguments to a data constructor. This is a common
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 5f1e4a2147..53838f39eb 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -496,7 +496,7 @@ interactiveUI config srcs maybe_exprs = do
-- The initial set of DynFlags used for interactive evaluation is the same
-- as the global DynFlags, plus -XExtendedDefaultRules and
-- -XNoMonomorphismRestriction.
- -- See note [Changing language extensions for interactive evaluation] #10857
+ -- See Note [Changing language extensions for interactive evaluation] #10857
dflags <- getDynFlags
let dflags' = (xopt_set_unlessExplSpec
LangExt.ExtendedDefaultRules xopt_set)