summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-10-30 08:44:34 +0300
committerVladislav Zavialov <vlad.z.4096@gmail.com>2019-11-27 11:32:18 +0300
commit8168b42a95ddf37c56958955eef065eb8747470f (patch)
treea677a67987372dac9732ea67f6ab37a77c02641a
parent5a08f7d405bbedfdc20c07f64726899f594e9d07 (diff)
downloadhaskell-8168b42a95ddf37c56958955eef065eb8747470f.tar.gz
Whitespace-sensitive bang patterns (#1087, #17162)wip/whitespace-and-lookahead
This patch implements a part of GHC Proposal #229 that covers five operators: * the bang operator (!) * the tilde operator (~) * the at operator (@) * the dollar operator ($) * the double dollar operator ($$) Based on surrounding whitespace, these operators are disambiguated into bang patterns, lazy patterns, strictness annotations, type applications, splices, and typed splices. This patch doesn't cover the (-) operator or the -Woperator-whitespace warning, which are left as future work.
-rw-r--r--compiler/GHC/Hs/Expr.hs23
-rw-r--r--compiler/main/DynFlags.hs3
-rw-r--r--compiler/parser/ApiAnnotation.hs4
-rw-r--r--compiler/parser/Lexer.x253
-rw-r--r--compiler/parser/Parser.y153
-rw-r--r--compiler/parser/RdrHsSyn.hs247
-rw-r--r--compiler/prelude/TysWiredIn.hs21
-rw-r--r--compiler/rename/RnEnv.hs8
-rw-r--r--compiler/rename/RnSplice.hs2
-rw-r--r--docs/users_guide/bugs.rst39
-rw-r--r--docs/users_guide/glasgow_exts.rst34
-rw-r--r--docs/users_guide/using-warnings.rst7
m---------nofib0
-rw-r--r--testsuite/tests/ghc-api/annotations/T10268.stdout2
-rw-r--r--testsuite/tests/ghc-api/annotations/T10276.stdout10
-rw-r--r--testsuite/tests/ghc-api/annotations/T10358.stdout4
-rw-r--r--testsuite/tests/ghc-api/annotations/T10399.stdout7
-rw-r--r--testsuite/tests/module/mod69.stderr4
-rw-r--r--testsuite/tests/module/mod70.stderr4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/T11103.stderr8
-rw-r--r--testsuite/tests/parser/should_compile/Proposal229f_instances.hs25
-rw-r--r--testsuite/tests/parser/should_compile/T1087.hs14
-rw-r--r--testsuite/tests/parser/should_compile/T16619.stderr3
-rw-r--r--testsuite/tests/parser/should_compile/all.T17
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229a.hs8
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229b.hs10
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229d.hs6
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229e.hs18
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229f.hs13
-rw-r--r--testsuite/tests/parser/should_compile/proposal-229f.stderr4
-rw-r--r--testsuite/tests/parser/should_fail/T14588.stderr2
-rw-r--r--testsuite/tests/parser/should_fail/T16270.stderr18
-rw-r--r--testsuite/tests/parser/should_fail/T17162.hs13
-rw-r--r--testsuite/tests/parser/should_fail/T17162.stderr4
-rw-r--r--testsuite/tests/parser/should_fail/T3811b.stderr2
-rw-r--r--testsuite/tests/parser/should_fail/T3811c.stderr9
-rw-r--r--testsuite/tests/parser/should_fail/T3811f.stderr6
-rw-r--r--testsuite/tests/parser/should_fail/all.T2
-rw-r--r--testsuite/tests/parser/should_fail/proposal-229c.hs6
-rw-r--r--testsuite/tests/parser/should_fail/proposal-229c.stderr4
-rw-r--r--testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr30
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr2
-rw-r--r--testsuite/tests/plugins/plugins10.stdout2
-rw-r--r--testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs1
-rw-r--r--testsuite/tests/printer/T13199.stdout32
-rw-r--r--testsuite/tests/printer/T13550.stdout4
-rw-r--r--testsuite/tests/printer/T13942.stdout4
-rw-r--r--testsuite/tests/printer/T14289.stdout4
-rw-r--r--testsuite/tests/printer/T14289b.stdout4
-rw-r--r--testsuite/tests/printer/T14289c.stdout4
-rw-r--r--testsuite/tests/rename/should_fail/T12879.stderr2
-rw-r--r--testsuite/tests/rename/should_fail/rnfail016.stderr4
-rw-r--r--testsuite/tests/rename/should_fail/rnfail016a.stderr2
-rw-r--r--testsuite/tests/rename/should_fail/rnfail051.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/T16718.stderr2
-rw-r--r--testsuite/tests/saks/should_compile/T17164.stderr2
-rw-r--r--testsuite/tests/saks/should_compile/saks027.stderr2
-rw-r--r--testsuite/tests/th/ClosedFam1TH.stderr2
-rw-r--r--testsuite/tests/th/T10279.stderr2
-rw-r--r--testsuite/tests/th/T10598_TH.stderr16
-rw-r--r--testsuite/tests/th/T10603.stderr2
-rw-r--r--testsuite/tests/th/T10638.stderr8
-rw-r--r--testsuite/tests/th/T10796b.stderr2
-rw-r--r--testsuite/tests/th/T10810.stderr2
-rw-r--r--testsuite/tests/th/T10828a.stderr2
-rw-r--r--testsuite/tests/th/T10828b.stderr2
-rw-r--r--testsuite/tests/th/T11452.stderr2
-rw-r--r--testsuite/tests/th/T12045TH1.stderr8
-rw-r--r--testsuite/tests/th/T12387.stderr2
-rw-r--r--testsuite/tests/th/T12411.stderr10
-rw-r--r--testsuite/tests/th/T12478_4.stderr2
-rw-r--r--testsuite/tests/th/T12530.stderr2
-rw-r--r--testsuite/tests/th/T13776.stderr14
-rw-r--r--testsuite/tests/th/T13837.stderr2
-rw-r--r--testsuite/tests/th/T13856.stderr2
-rw-r--r--testsuite/tests/th/T13968.stderr2
-rw-r--r--testsuite/tests/th/T14204.stderr2
-rw-r--r--testsuite/tests/th/T14646.stderr2
-rw-r--r--testsuite/tests/th/T14681.stderr4
-rw-r--r--testsuite/tests/th/T14817.stderr2
-rw-r--r--testsuite/tests/th/T14869.stderr10
-rw-r--r--testsuite/tests/th/T14875.stderr2
-rw-r--r--testsuite/tests/th/T14888.stderr6
-rw-r--r--testsuite/tests/th/T15243.stderr14
-rw-r--r--testsuite/tests/th/T15270A.stderr6
-rw-r--r--testsuite/tests/th/T15270B.stderr6
-rw-r--r--testsuite/tests/th/T15324.stderr2
-rw-r--r--testsuite/tests/th/T15331.stderr2
-rw-r--r--testsuite/tests/th/T15360b.stderr8
-rw-r--r--testsuite/tests/th/T15365.stderr2
-rw-r--r--testsuite/tests/th/T15481.stderr2
-rw-r--r--testsuite/tests/th/T15502.stderr-ws-324
-rw-r--r--testsuite/tests/th/T15502.stderr-ws-644
-rw-r--r--testsuite/tests/th/T15518.stderr2
-rw-r--r--testsuite/tests/th/T15550.stderr2
-rw-r--r--testsuite/tests/th/T15572.stderr8
-rw-r--r--testsuite/tests/th/T15738.stderr2
-rw-r--r--testsuite/tests/th/T16133.stderr4
-rw-r--r--testsuite/tests/th/T16183.stderr2
-rw-r--r--testsuite/tests/th/T16326_TH.stderr2
-rw-r--r--testsuite/tests/th/T16666.stderr2
-rw-r--r--testsuite/tests/th/T16895a.stderr2
-rw-r--r--testsuite/tests/th/T16895b.stderr6
-rw-r--r--testsuite/tests/th/T16895c.stderr6
-rw-r--r--testsuite/tests/th/T16895d.stderr6
-rw-r--r--testsuite/tests/th/T16895e.stderr6
-rw-r--r--testsuite/tests/th/T17379a.stderr2
-rw-r--r--testsuite/tests/th/T17379b.stderr2
-rw-r--r--testsuite/tests/th/T17380.stderr4
-rw-r--r--testsuite/tests/th/T17394.stderr4
-rw-r--r--testsuite/tests/th/T17461.stderr2
-rw-r--r--testsuite/tests/th/T2597b.stderr8
-rw-r--r--testsuite/tests/th/T2674.stderr2
-rw-r--r--testsuite/tests/th/T3177a.stderr2
-rw-r--r--testsuite/tests/th/T3319.stderr2
-rw-r--r--testsuite/tests/th/T3395.stderr20
-rw-r--r--testsuite/tests/th/T3600.stderr2
-rw-r--r--testsuite/tests/th/T3899.stderr2
-rw-r--r--testsuite/tests/th/T4436.stderr4
-rw-r--r--testsuite/tests/th/T5217.stderr2
-rw-r--r--testsuite/tests/th/T5290.stderr10
-rw-r--r--testsuite/tests/th/T5358.stderr4
-rw-r--r--testsuite/tests/th/T5508.stderr2
-rw-r--r--testsuite/tests/th/T5700.stderr2
-rw-r--r--testsuite/tests/th/T5795.stderr10
-rw-r--r--testsuite/tests/th/T5883.stderr2
-rw-r--r--testsuite/tests/th/T5971.stderr12
-rw-r--r--testsuite/tests/th/T5976.stderr2
-rw-r--r--testsuite/tests/th/T5984.stderr11
-rw-r--r--testsuite/tests/th/T6018th.stderr6
-rw-r--r--testsuite/tests/th/T7241.stderr6
-rw-r--r--testsuite/tests/th/T7477.stderr2
-rw-r--r--testsuite/tests/th/T7484.stderr2
-rw-r--r--testsuite/tests/th/T7532.stderr2
-rw-r--r--testsuite/tests/th/T7667a.stderr8
-rw-r--r--testsuite/tests/th/T8412.stderr6
-rw-r--r--testsuite/tests/th/T8577.stderr12
-rw-r--r--testsuite/tests/th/T8624.stdout2
-rw-r--r--testsuite/tests/th/T8759.stderr2
-rw-r--r--testsuite/tests/th/T8932.stderr2
-rw-r--r--testsuite/tests/th/T8987.stderr2
-rw-r--r--testsuite/tests/th/TH_1tuple.stderr2
-rw-r--r--testsuite/tests/th/TH_Promoted1Tuple.stderr2
-rw-r--r--testsuite/tests/th/TH_PromotedList.stderr2
-rw-r--r--testsuite/tests/th/TH_PromotedTuple.stderr6
-rw-r--r--testsuite/tests/th/TH_RichKinds.stderr6
-rw-r--r--testsuite/tests/th/TH_RichKinds2.stderr2
-rw-r--r--testsuite/tests/th/TH_Roles1.stderr8
-rw-r--r--testsuite/tests/th/TH_StaticPointers02.stderr22
-rw-r--r--testsuite/tests/th/TH_TyInstWhere1.stderr6
-rw-r--r--testsuite/tests/th/TH_TyInstWhere2.stderr4
-rw-r--r--testsuite/tests/th/TH_dupdecl.stderr6
-rw-r--r--testsuite/tests/th/TH_exn1.stderr4
-rw-r--r--testsuite/tests/th/TH_exn2.stderr4
-rw-r--r--testsuite/tests/th/TH_fail.stderr2
-rw-r--r--testsuite/tests/th/TH_foreignCallingConventions.stderr12
-rw-r--r--testsuite/tests/th/TH_foreignInterruptible.stderr7
-rw-r--r--testsuite/tests/th/TH_genEx.stderr4
-rw-r--r--testsuite/tests/th/TH_implicitParamsErr1.stderr2
-rw-r--r--testsuite/tests/th/TH_implicitParamsErr2.stderr2
-rw-r--r--testsuite/tests/th/TH_implicitParamsErr3.stderr2
-rw-r--r--testsuite/tests/th/TH_invalid_add_top_decl.stderr2
-rw-r--r--testsuite/tests/th/TH_pragma.stderr4
-rw-r--r--testsuite/tests/th/TH_recover_warns.stderr4
-rw-r--r--testsuite/tests/th/TH_runIO.stderr10
-rw-r--r--testsuite/tests/th/TH_spliceD1.stderr10
-rw-r--r--testsuite/tests/th/TH_unresolvedInfix2.stderr20
-rw-r--r--testsuite/tests/typecheck/should_fail/T14761b.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/T15527.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/T7210.stderr10
m---------utils/haddock0
172 files changed, 937 insertions, 742 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 52d0448cc6..7921a61697 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -2308,9 +2308,8 @@ type instance XXSplice (GhcPass _) = NoExtCon
-- type captures explicitly how it was originally written, for use in the pretty
-- printer.
data SpliceDecoration
- = HasParens -- ^ $( splice ) or $$( splice )
- | HasDollar -- ^ $splice or $$splice
- | NoParens -- ^ bare splice
+ = DollarSplice -- ^ $splice or $$splice
+ | BareSplice -- ^ bare splice
deriving (Data, Eq, Show)
instance Outputable SpliceDecoration where
@@ -2452,12 +2451,12 @@ instance (OutputableBndrId p) => Outputable (HsSplice (GhcPass p)) where
pprPendingSplice :: (OutputableBndrId p)
=> SplicePointName -> LHsExpr (GhcPass p) -> SDoc
-pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
+pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr (stripParensHsExpr e))
pprSpliceDecl :: (OutputableBndrId p)
=> HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
-pprSpliceDecl e ExplicitSplice = text "$(" <> ppr_splice_decl e <> text ")"
+pprSpliceDecl e ExplicitSplice = text "$" <> ppr_splice_decl e
pprSpliceDecl e ImplicitSplice = ppr_splice_decl e
ppr_splice_decl :: (OutputableBndrId p)
@@ -2466,17 +2465,13 @@ ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
ppr_splice_decl e = pprSplice e
pprSplice :: (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc
-pprSplice (HsTypedSplice _ HasParens n e)
- = ppr_splice (text "$$(") n e (text ")")
-pprSplice (HsTypedSplice _ HasDollar n e)
+pprSplice (HsTypedSplice _ DollarSplice n e)
= ppr_splice (text "$$") n e empty
-pprSplice (HsTypedSplice _ NoParens n e)
- = ppr_splice empty n e empty
-pprSplice (HsUntypedSplice _ HasParens n e)
- = ppr_splice (text "$(") n e (text ")")
-pprSplice (HsUntypedSplice _ HasDollar n e)
+pprSplice (HsTypedSplice _ BareSplice _ _ )
+ = panic "Bare typed splice" -- impossible
+pprSplice (HsUntypedSplice _ DollarSplice n e)
= ppr_splice (text "$") n e empty
-pprSplice (HsUntypedSplice _ NoParens n e)
+pprSplice (HsUntypedSplice _ BareSplice n e)
= ppr_splice empty n e empty
pprSplice (HsQuasiQuote _ n q _ s) = ppr_quasi n q s
pprSplice (HsSpliced _ _ thing) = ppr thing
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d86c064ba8..d3cd6577ab 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -4137,7 +4137,8 @@ wWarningFlagsDeps = [
flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags,
flagSpec "star-binder" Opt_WarnStarBinder,
flagSpec "star-is-type" Opt_WarnStarIsType,
- flagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang,
+ depFlagSpec "missing-space-after-bang" Opt_WarnSpaceAfterBang
+ "bang patterns can no longer be written with a space",
flagSpec "partial-fields" Opt_WarnPartialFields,
flagSpec "prepositive-qualified-module"
Opt_WarnPrepositiveQualifiedModule,
diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs
index bfb39c8f7b..ca88716f34 100644
--- a/compiler/parser/ApiAnnotation.hs
+++ b/compiler/parser/ApiAnnotation.hs
@@ -258,9 +258,9 @@ data AnnKeywordId
| AnnOpenEQ -- ^ '[|'
| AnnOpenEQU -- ^ '[|', unicode variant
| AnnOpenP -- ^ '('
- | AnnOpenPE -- ^ '$('
- | AnnOpenPTE -- ^ '$$('
| AnnOpenS -- ^ '['
+ | AnnDollar -- ^ prefix '$' -- TemplateHaskell
+ | AnnDollarDollar -- ^ prefix '$$' -- TemplateHaskell
| AnnPackageName
| AnnPattern
| AnnProc
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 2ada289db4..160cb8c357 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -44,6 +44,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
@@ -376,10 +377,6 @@ $tab { warnTab }
"[t|" / { ifExtension ThQuotesBit } { token ITopenTypQuote }
"|]" / { ifExtension ThQuotesBit } { token (ITcloseQuote NormalSyntax) }
"||]" / { ifExtension ThQuotesBit } { token ITcloseTExpQuote }
- \$ @varid / { ifExtension ThBit } { skip_one_varid ITidEscape }
- "$$" @varid / { ifExtension ThBit } { skip_two_varid ITidTyEscape }
- "$(" / { ifExtension ThBit } { token ITparenEscape }
- "$$(" / { ifExtension ThBit } { token ITparenTyEscape }
"[" @varid "|" / { ifExtension QqBit } { lex_quasiquote_tok }
@@ -398,14 +395,6 @@ $tab { warnTab }
{ token (ITcloseQuote UnicodeSyntax) }
}
- -- See Note [Lexing type applications]
-<0> {
- [^ $idchar \) ] ^
- "@"
- / { ifExtension TypeApplicationsBit `alexAndPred` notFollowedBySymbol }
- { token ITtypeApp }
-}
-
<0> {
"(|"
/ { ifExtension ArrowsBit `alexAndPred`
@@ -471,12 +460,20 @@ $tab { warnTab }
@conid "#"+ / { ifExtension MagicHashBit } { idtoken conid }
}
+-- Operators classified into prefix, suffix, tight infix, and loose infix.
+-- See Note [Whitespace-sensitive operator parsing]
+<0> {
+ @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix }
+ @varsym / { followedByOpeningToken } { varsym_prefix }
+ @varsym / { precededByClosingToken } { varsym_suffix }
+ @varsym { varsym_loose_infix }
+}
+
-- ToDo: - move `var` and (sym) into lexical syntax?
-- - remove backquote from $special?
<0> {
@qvarsym { idtoken qvarsym }
@qconsym { idtoken qconsym }
- @varsym { varsym }
@consym { consym }
}
@@ -550,32 +547,114 @@ $tab { warnTab }
\" { lex_string_tok }
}
--- Note [Lexing type applications]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- The desired syntax for type applications is to prefix the type application
--- with '@', like this:
+-- Note [Whitespace-sensitive operator parsing]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In accord with GHC Proposal #229 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst
+-- we classify operator occurrences into four categories:
+--
+-- a ! b -- a loose infix occurrence
+-- a!b -- a tight infix occurrence
+-- a !b -- a prefix occurrence
+-- a! b -- a suffix occurrence
+--
+-- The rules are a bit more elaborate than simply checking for whitespace, in
+-- order to accomodate the following use cases:
+--
+-- f (!a) = ... -- prefix occurrence
+-- g (a !) -- loose infix occurrence
+-- g (! a) -- loose infix occurrence
+--
+-- The precise rules are as follows:
+--
+-- * Identifiers, literals, and opening brackets (, (#, [, [|, [||, [p|, [e|,
+-- [t|, {, are considered "opening tokens". The function followedByOpeningToken
+-- tests whether the next token is an opening token.
+--
+-- * Identifiers, literals, and closing brackets ), #), ], |], },
+-- are considered "closing tokens". The function precededByClosingToken tests
+-- whether the previous token is a closing token.
--
--- foo @Int @Bool baz bum
+-- * Whitespace, comments, separators, and other tokens, are considered
+-- neither opening nor closing.
--
--- This, of course, conflicts with as-patterns. The conflict arises because
--- expressions and patterns use the same parser, and also because we want
--- to allow type patterns within expression patterns.
+-- * Any unqualified operator occurrence is classified as prefix, suffix, or
+-- tight/loose infix, based on preceding and following tokens:
--
--- Disambiguation is accomplished by requiring *something* to appear between
--- type application and the preceding token. This something must end with
--- a character that cannot be the end of the variable bound in an as-pattern.
--- Currently (June 2015), this means that the something cannot end with a
--- $idchar or a close-paren. (The close-paren is necessary if the as-bound
--- identifier is symbolic.)
+-- precededByClosingToken | followedByOpeningToken | Occurrence
+-- ------------------------+------------------------+------------
+-- False | True | prefix
+-- True | False | suffix
+-- True | True | tight infix
+-- False | False | loose infix
+-- ------------------------+------------------------+------------
--
--- Note that looking for whitespace before the '@' is insufficient, because
--- of this pathological case:
+-- A loose infix occurrence is always considered an operator. Other types of
+-- occurrences may be assigned a special per-operator meaning override:
--
--- foo {- hi -}@Int
+-- Operator | Occurrence | Token returned
+-- ----------+---------------+------------------------------------------
+-- ! | prefix | ITbang
+-- | | strictness annotation or bang pattern,
+-- | | e.g. f !x = rhs, data T = MkT !a
+-- | not prefix | ITvarsym "!"
+-- | | ordinary operator or type operator,
+-- | | e.g. xs ! 3, (! x), Int ! Bool
+-- ----------+---------------+------------------------------------------
+-- ~ | prefix | ITtilde
+-- | | laziness annotation or lazy pattern,
+-- | | e.g. f ~x = rhs, data T = MkT ~a
+-- | not prefix | ITvarsym "~"
+-- | | ordinary operator or type operator,
+-- | | e.g. xs ~ 3, (~ x), Int ~ Bool
+-- ----------+---------------+------------------------------------------
+-- $ $$ | prefix | ITdollar, ITdollardollar
+-- | | untyped or typed Template Haskell splice,
+-- | | e.g. $(f x), $$(f x), $$"str"
+-- | not prefix | ITvarsym "$", ITvarsym "$$"
+-- | | ordinary operator or type operator,
+-- | | e.g. f $ g x, a $$ b
+-- ----------+---------------+------------------------------------------
+-- @ | prefix | ITtypeApp
+-- | | type application, e.g. fmap @Maybe
+-- | tight infix | ITat
+-- | | as-pattern, e.g. f p@(a,b) = rhs
+-- | suffix | parse error
+-- | | e.g. f p@ x = rhs
+-- | loose infix | ITvarsym "@"
+-- | | ordinary operator or type operator,
+-- | | e.g. f @ g, (f @)
+-- ----------+---------------+------------------------------------------
--
--- This design is predicated on the fact that as-patterns are generally
--- whitespace-free, and also that this whole thing is opt-in, with the
--- TypeApplications extension.
+-- Also, some of these overrides are guarded behind language extensions.
+-- According to the specification, we must determine the occurrence based on
+-- surrounding *tokens* (see the proposal for the exact rules). However, in
+-- the implementation we cheat a little and do the classification based on
+-- characters, for reasons of both simplicity and efficiency (see
+-- 'followedByOpeningToken' and 'precededByClosingToken')
+--
+-- When an operator is subject to a meaning override, it is mapped to special
+-- token: ITbang, ITtilde, ITat, ITdollar, ITdollardollar. Otherwise, it is
+-- returned as ITvarsym.
+--
+-- For example, this is how we process the (!):
+--
+-- precededByClosingToken | followedByOpeningToken | Token
+-- ------------------------+------------------------+-------------
+-- False | True | ITbang
+-- True | False | ITvarsym "!"
+-- True | True | ITvarsym "!"
+-- False | False | ITvarsym "!"
+-- ------------------------+------------------------+-------------
+--
+-- And this is how we process the (@):
+--
+-- precededByClosingToken | followedByOpeningToken | Token
+-- ------------------------+------------------------+-------------
+-- False | True | ITtypeApp
+-- True | False | parse error
+-- True | True | ITat
+-- False | False | ITvarsym "@"
+-- ------------------------+------------------------+-------------
-- -----------------------------------------------------------------------------
-- Alex "Haskell code fragment bottom"
@@ -680,11 +759,12 @@ data Token
| ITvbar
| ITlarrow IsUnicodeSyntax
| ITrarrow IsUnicodeSyntax
- | ITat
- | ITtilde
| ITdarrow IsUnicodeSyntax
| ITminus
- | ITbang
+ | ITbang -- Prefix (!) only, e.g. f !x = rhs
+ | ITtilde -- Prefix (~) only, e.g. f ~x = rhs
+ | ITat -- Tight infix (@) only, e.g. f x@pat = rhs
+ | ITtypeApp -- Prefix (@) only, e.g. f @t
| ITstar IsUnicodeSyntax
| ITdot
@@ -740,10 +820,8 @@ data Token
| ITcloseQuote IsUnicodeSyntax -- |]
| ITopenTExpQuote HasE -- [|| or [e||
| ITcloseTExpQuote -- ||]
- | ITidEscape FastString -- $x
- | ITparenEscape -- $(
- | ITidTyEscape FastString -- $$x
- | ITparenTyEscape -- $$(
+ | ITdollar -- prefix $
+ | ITdollardollar -- prefix $$
| ITtyQuote -- ''
| ITquasiQuote (FastString,FastString,RealSrcSpan)
-- ITquasiQuote(quoter, quote, loc)
@@ -764,11 +842,6 @@ data Token
| ITLarrowtail IsUnicodeSyntax -- ^ @-<<@
| ITRarrowtail IsUnicodeSyntax -- ^ @>>-@
- -- | Type application '@' (lexed differently than as-pattern '@',
- -- due to checking for preceding whitespace)
- | ITtypeApp
-
-
| ITunknown String -- ^ Used when the lexer can't make sense of it
| ITeof -- ^ end of file token
@@ -889,11 +962,8 @@ reservedSymsFM = listToUFM $
,("|", ITvbar, NormalSyntax, 0 )
,("<-", ITlarrow NormalSyntax, NormalSyntax, 0 )
,("->", ITrarrow NormalSyntax, NormalSyntax, 0 )
- ,("@", ITat, NormalSyntax, 0 )
- ,("~", ITtilde, NormalSyntax, 0 )
,("=>", ITdarrow NormalSyntax, NormalSyntax, 0 )
,("-", ITminus, NormalSyntax, 0 )
- ,("!", ITbang, NormalSyntax, 0 )
,("*", ITstar NormalSyntax, NormalSyntax, xbit StarIsTypeBit)
@@ -988,6 +1058,32 @@ pop_and :: Action -> Action
pop_and act span buf len = do _ <- popLexState
act span buf len
+-- See Note [Whitespace-sensitive operator parsing]
+followedByOpeningToken :: AlexAccPred ExtsBitmap
+followedByOpeningToken _ _ _ (AI _ buf)
+ | atEnd buf = False
+ | otherwise =
+ case nextChar buf of
+ ('{', buf') -> nextCharIsNot buf' (== '-')
+ ('(', _) -> True
+ ('[', _) -> True
+ ('\"', _) -> True
+ ('\'', _) -> True
+ ('_', _) -> True
+ (c, _) -> isAlphaNum c
+
+-- See Note [Whitespace-sensitive operator parsing]
+precededByClosingToken :: AlexAccPred ExtsBitmap
+precededByClosingToken _ (AI _ buf) _ _ =
+ case prevChar buf '\n' of
+ '}' -> decodePrevNChars 1 buf /= "-"
+ ')' -> True
+ ']' -> True
+ '\"' -> True
+ '\'' -> True
+ '_' -> True
+ c -> isAlphaNum c
+
{-# INLINE nextCharIs #-}
nextCharIs :: StringBuffer -> (Char -> Bool) -> Bool
nextCharIs buf p = not (atEnd buf) && p (currentChar buf)
@@ -1348,11 +1444,40 @@ qvarsym, qconsym :: StringBuffer -> Int -> Token
qvarsym buf len = ITqvarsym $! splitQualName buf len False
qconsym buf len = ITqconsym $! splitQualName buf len False
-varsym, consym :: Action
-varsym = sym ITvarsym
-consym = sym ITconsym
-
-sym :: (FastString -> Token) -> Action
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_prefix :: Action
+varsym_prefix = sym $ \exts s ->
+ if | TypeApplicationsBit `xtest` exts, s == fsLit "@"
+ -> return ITtypeApp
+ | ThBit `xtest` exts, s == fsLit "$"
+ -> return ITdollar
+ | ThBit `xtest` exts, s == fsLit "$$"
+ -> return ITdollardollar
+ | s == fsLit "!" -> return ITbang
+ | s == fsLit "~" -> return ITtilde
+ | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_suffix :: Action
+varsym_suffix = sym $ \_ s ->
+ if | s == fsLit "@"
+ -> failMsgP "Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
+ | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_tight_infix :: Action
+varsym_tight_infix = sym $ \_ s ->
+ if | s == fsLit "@" -> return ITat
+ | otherwise -> return (ITvarsym s)
+
+-- See Note [Whitespace-sensitive operator parsing]
+varsym_loose_infix :: Action
+varsym_loose_infix = sym (\_ s -> return $ ITvarsym s)
+
+consym :: Action
+consym = sym (\_exts s -> return $ ITconsym s)
+
+sym :: (ExtsBitmap -> FastString -> P Token) -> Action
sym con span buf len =
case lookupUFM reservedSymsFM fs of
Just (keyword, NormalSyntax, 0) ->
@@ -1361,19 +1486,20 @@ sym con span buf len =
exts <- getExts
if exts .&. i /= 0
then return $ L span keyword
- else return $ L span (con fs)
+ else L span <$!> con exts fs
Just (keyword, UnicodeSyntax, 0) -> do
exts <- getExts
if xtest UnicodeSyntaxBit exts
then return $ L span keyword
- else return $ L span (con fs)
+ else L span <$!> con exts fs
Just (keyword, UnicodeSyntax, i) -> do
exts <- getExts
if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
then return $ L span keyword
- else return $ L span (con fs)
- Nothing ->
- return $ L span $! con fs
+ else L span <$!> con exts fs
+ Nothing -> do
+ exts <- getExts
+ L span <$!> con exts fs
where
!fs = lexemeToFastString buf len
@@ -2889,8 +3015,6 @@ isALRopen ITobrack = True
isALRopen ITocurly = True
-- GHC Extensions:
isALRopen IToubxparen = True
-isALRopen ITparenEscape = True
-isALRopen ITparenTyEscape = True
isALRopen _ = False
isALRclose :: Token -> Bool
@@ -2945,12 +3069,9 @@ lexToken = do
let bytes = byteDiff buf buf2
span `seq` setLastToken span bytes
lt <- t span buf bytes
- case unRealSrcSpan lt of
- ITlineComment _ -> return lt
- ITblockComment _ -> return lt
- lt' -> do
- setLastTk lt'
- return lt
+ let lt' = unRealSrcSpan lt
+ unless (isComment lt') (setLastTk lt')
+ return lt
reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> [Char] -> P a
reportLexError loc1 loc2 buf str
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 5fea8646a4..8ee4053d08 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -93,7 +93,7 @@ import Util ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
import GhcPrelude
}
-%expect 236 -- shift/reduce conflicts
+%expect 232 -- shift/reduce conflicts
{- Last updated: 04 June 2018
@@ -541,18 +541,18 @@ are the most common patterns, rewritten as regular expressions for clarity:
'|' { L _ ITvbar }
'<-' { L _ (ITlarrow _) }
'->' { L _ (ITrarrow _) }
- '@' { L _ ITat }
- '~' { L _ ITtilde }
+ TIGHT_INFIX_AT { L _ ITat }
'=>' { L _ (ITdarrow _) }
'-' { L _ ITminus }
- '!' { L _ ITbang }
+ PREFIX_TILDE { L _ ITtilde }
+ PREFIX_BANG { L _ ITbang }
'*' { L _ (ITstar _) }
'-<' { L _ (ITlarrowtail _) } -- for arrow notation
'>-' { L _ (ITrarrowtail _) } -- for arrow notation
'-<<' { L _ (ITLarrowtail _) } -- for arrow notation
'>>-' { L _ (ITRarrowtail _) } -- for arrow notation
'.' { L _ ITdot }
- TYPEAPP { L _ ITtypeApp }
+ PREFIX_AT { L _ ITtypeApp }
'{' { L _ ITocurly } -- special symbols
'}' { L _ ITccurly }
@@ -610,10 +610,8 @@ are the most common patterns, rewritten as regular expressions for clarity:
'|]' { L _ (ITcloseQuote _) }
'[||' { L _ (ITopenTExpQuote _) }
'||]' { L _ ITcloseTExpQuote }
-TH_ID_SPLICE { L _ (ITidEscape _) } -- $x
-'$(' { L _ ITparenEscape } -- $( exp )
-TH_ID_TY_SPLICE { L _ (ITidTyEscape _) } -- $$x
-'$$(' { L _ ITparenTyEscape } -- $$( exp )
+PREFIX_DOLLAR { L _ ITdollar }
+PREFIX_DOLLAR_DOLLAR { L _ ITdollardollar }
TH_TY_QUOTE { L _ ITtyQuote } -- ''T
TH_QUASIQUOTE { L _ (ITquasiQuote _) }
TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) }
@@ -647,8 +645,6 @@ identifier :: { Located RdrName }
| qconop { $1 }
| '(' '->' ')' {% ams (sLL $1 $> $ getRdrName funTyCon)
[mop $1,mu AnnRarrow $2,mcp $3] }
- | '(' '~' ')' {% ams (sLL $1 $> $ eqTyCon_RDR)
- [mop $1,mj AnnTilde $2,mcp $3] }
-----------------------------------------------------------------------------
-- Backpack stuff
@@ -1681,13 +1677,30 @@ rule_activation :: { ([AddAnn],Maybe Activation) }
: {- empty -} { ([],Nothing) }
| rule_explicit_activation { (fst $1,Just (snd $1)) }
+-- This production is used to parse the tilde syntax in pragmas such as
+-- * {-# INLINE[~2] ... #-}
+-- * {-# SPECIALISE [~ 001] ... #-}
+-- * {-# RULES ... [~0] ... g #-}
+-- Note that it can be written either
+-- without a space [~1] (the PREFIX_TILDE case), or
+-- with a space [~ 1] (the VARSYM case).
+-- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+rule_activation_marker :: { [AddAnn] }
+ : PREFIX_TILDE { [mj AnnTilde $1] }
+ | VARSYM {% if (getVARSYM $1 == fsLit "~")
+ then return [mj AnnTilde $1]
+ else do { addError (getLoc $1) $ text "Invalid rule activation marker"
+ ; return [] } }
+
rule_explicit_activation :: { ([AddAnn]
,Activation) } -- In brackets
: '[' INTEGER ']' { ([mos $1,mj AnnVal $2,mcs $3]
,ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
- | '[' '~' INTEGER ']' { ([mos $1,mj AnnTilde $2,mj AnnVal $3,mcs $4]
+ | '[' rule_activation_marker INTEGER ']'
+ { ($2++[mos $1,mj AnnVal $3,mcs $4]
,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
- | '[' '~' ']' { ([mos $1,mj AnnTilde $2,mcs $3]
+ | '[' rule_activation_marker ']'
+ { ($2++[mos $1,mcs $3]
,NeverActive) }
rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr GhcPs], [LRuleBndr GhcPs]) }
@@ -2026,10 +2039,11 @@ tyapps :: { [Located TyEl] } -- NB: This list is reversed
tyapp :: { Located TyEl }
: atype { sL1 $1 $ TyElOpd (unLoc $1) }
- | TYPEAPP atype { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
- | qtyconop { sL1 $1 $ if isBangRdr (unLoc $1) then TyElBang else
- if isTildeRdr (unLoc $1) then TyElTilde else
- TyElOpr (unLoc $1) }
+
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ | PREFIX_AT atype { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
+
+ | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) }
| tyvarop { sL1 $1 $ TyElOpr (unLoc $1) }
| SIMPLEQUOTE qconop {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
[mj AnnSimpleQuote $1,mj AnnVal $2] }
@@ -2042,6 +2056,11 @@ atype :: { LHsType GhcPs }
| tyvar { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples])
| '*' {% do { warnStarIsType (getLoc $1)
; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } }
+
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ | PREFIX_TILDE atype {% ams (sLL $1 $> (mkBangTy SrcLazy $2)) [mj AnnTilde $1] }
+ | PREFIX_BANG atype {% ams (sLL $1 $> (mkBangTy SrcStrict $2)) [mj AnnBang $1] }
+
| '{' fielddecls '}' {% amms (checkRecordSyntax
(sLL $1 $> $ HsRecTy noExtField $2))
-- Constructor sigs only
@@ -2411,25 +2430,8 @@ docdecld :: { LDocDecl }
decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
- | '!' aexp rhs {% runECP_P $2 >>= \ $2 ->
- do { let { e = patBuilderBang (getLoc $1) $2
- ; l = comb2 $1 $> };
- (ann, r) <- checkValDef SrcStrict e Nothing $3 ;
- runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ;
- -- Depending upon what the pattern looks like we might get either
- -- a FunBind or PatBind back from checkValDef. See Note
- -- [FunBind vs PatBind]
- case r of {
- (FunBind _ n _ _ _) ->
- amsL l [mj AnnFunId n] >> return () ;
- (PatBind _ (dL->L l _) _rhs _) ->
- amsL l [] >> return () } ;
-
- _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
- return $! (sL l $ ValD noExtField r) } }
-
| infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 ->
- do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
+ do { (ann,r) <- checkValDef $1 (snd $2) $3;
let { l = comb2 $1 $> };
-- Depending upon what the pattern looks like we might get either
-- a FunBind or PatBind back from checkValDef. See Note
@@ -2551,8 +2553,8 @@ activation :: { ([AddAnn],Maybe Activation) }
explicit_activation :: { ([AddAnn],Activation) } -- In brackets
: '[' INTEGER ']' { ([mj AnnOpenS $1,mj AnnVal $2,mj AnnCloseS $3]
,ActiveAfter (getINTEGERs $2) (fromInteger (il_value (getINTEGER $2)))) }
- | '[' '~' INTEGER ']' { ([mj AnnOpenS $1,mj AnnTilde $2,mj AnnVal $3
- ,mj AnnCloseS $4]
+ | '[' rule_activation_marker INTEGER ']'
+ { ($2++[mj AnnOpenS $1,mj AnnVal $3,mj AnnCloseS $4]
,ActiveBefore (getINTEGERs $3) (fromInteger (il_value (getINTEGER $3)))) }
-----------------------------------------------------------------------------
@@ -2694,11 +2696,14 @@ fexp :: { ECP }
runECP_PV $1 >>= \ $1 ->
runECP_PV $2 >>= \ $2 ->
mkHsAppPV (comb2 $1 $>) $1 $2 }
- | fexp TYPEAPP atype {% runECP_P $1 >>= \ $1 ->
+
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ | fexp PREFIX_AT atype {% runECP_P $1 >>= \ $1 ->
runPV (checkExpBlockArguments $1) >>= \_ ->
fmap ecpFromExp $
ams (sLL $1 $> $ HsAppType noExtField $1 (mkHsWildCardBndrs $3))
[mj AnnAt $2] }
+
| 'static' aexp {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
ams (sLL $1 $> $ HsStatic noExtField $2)
@@ -2706,15 +2711,19 @@ fexp :: { ECP }
| aexp { $1 }
aexp :: { ECP }
- : qvar '@' aexp { ECP $
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ : qvar TIGHT_INFIX_AT aexp
+ { ECP $
runECP_PV $3 >>= \ $3 ->
amms (mkHsAsPatPV (comb2 $1 $>) $1 $3) [mj AnnAt $2] }
- -- If you change the parsing, make sure to understand
- -- Note [Lexing type applications] in Lexer.x
- | '~' aexp { ECP $
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ | PREFIX_TILDE aexp { ECP $
runECP_PV $2 >>= \ $2 ->
amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] }
+ | PREFIX_BANG aexp { ECP $
+ runECP_PV $2 >>= \ $2 ->
+ amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1] }
| '\\' apat apats '->' exp
{ ECP $
@@ -2863,22 +2872,17 @@ splice_exp :: { LHsExpr GhcPs }
| splice_typed { mapLoc (HsSpliceE noExtField) $1 }
splice_untyped :: { Located (HsSplice GhcPs) }
- : TH_ID_SPLICE {% ams (sL1 $1 $ mkUntypedSplice HasDollar
- (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName
- (getTH_ID_SPLICE $1)))))
- [mj AnnThIdSplice $1] }
- | '$(' exp ')' {% runECP_P $2 >>= \ $2 ->
- ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
- [mj AnnOpenPE $1,mj AnnCloseP $3] }
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ : PREFIX_DOLLAR aexp2 {% runECP_P $2 >>= \ $2 ->
+ ams (sLL $1 $> $ mkUntypedSplice DollarSplice $2)
+ [mj AnnDollar $1] }
splice_typed :: { Located (HsSplice GhcPs) }
- : TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkTypedSplice HasDollar
- (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName
- (getTH_ID_TY_SPLICE $1)))))
- [mj AnnThIdTySplice $1] }
- | '$$(' exp ')' {% runECP_P $2 >>= \ $2 ->
- ams (sLL $1 $> $ mkTypedSplice HasParens $2)
- [mj AnnOpenPTE $1,mj AnnCloseP $3] }
+ -- See Note [Whitespace-sensitive operator parsing] in Lexer.x
+ : PREFIX_DOLLAR_DOLLAR aexp2
+ {% runECP_P $2 >>= \ $2 ->
+ ams (sLL $1 $> $ mkTypedSplice DollarSplice $2)
+ [mj AnnDollarDollar $1] }
cmdargs :: { [LHsCmdTop GhcPs] }
: cmdargs acmd { $2 : $1 }
@@ -3194,24 +3198,14 @@ gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) }
-- we parse them right when bang-patterns are off
pat :: { LPat GhcPs }
pat : exp {% (checkPattern <=< runECP_P) $1 }
- | '!' aexp {% runECP_P $2 >>= \ $2 ->
- amms (checkPattern (patBuilderBang (getLoc $1) $2))
- [mj AnnBang $1] }
bindpat :: { LPat GhcPs }
bindpat : exp {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
checkPattern_msg (text "Possibly caused by a missing 'do'?")
(runECP_PV $1) }
- | '!' aexp {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn
- amms (checkPattern_msg (text "Possibly caused by a missing 'do'?")
- (patBuilderBang (getLoc $1) `fmap` runECP_PV $2))
- [mj AnnBang $1] }
apat :: { LPat GhcPs }
apat : aexp {% (checkPattern <=< runECP_P) $1 }
- | '!' aexp {% runECP_P $2 >>= \ $2 ->
- amms (checkPattern (patBuilderBang (getLoc $1) $2))
- [mj AnnBang $1] }
apats :: { [LPat GhcPs] }
: apat apats { $1 : $2 }
@@ -3473,7 +3467,6 @@ oqtycon_no_varcon :: { Located RdrName } -- Type constructor which cannot be mi
| '(' ':' ')' {% let { name :: Located RdrName
; name = sL1 $2 $! consDataCon_RDR }
in ams (sLL $1 $> (unLoc name)) [mop $1,mj AnnVal name,mcp $3] }
- | '(' '~' ')' {% ams (sLL $1 $> $ eqTyCon_RDR) [mop $1,mj AnnTilde $2,mcp $3] }
{- Note [Type constructors in export list]
~~~~~~~~~~~~~~~~~~~~~
@@ -3519,12 +3512,14 @@ qtyconsym :: { Located RdrName }
tyconsym :: { Located RdrName }
: CONSYM { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
- | VARSYM { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
+ | VARSYM { sL1 $1 $!
+ -- See Note [eqTyCon (~) is built-in syntax] in TysWiredIn
+ if getVARSYM $1 == fsLit "~"
+ then eqTyCon_RDR
+ else mkUnqual tcClsName (getVARSYM $1) }
| ':' { sL1 $1 $! consDataCon_RDR }
| '-' { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
- | '!' { sL1 $1 $! mkUnqual tcClsName (fsLit "!") }
| '.' { sL1 $1 $! mkUnqual tcClsName (fsLit ".") }
- | '~' { sL1 $1 $ eqTyCon_RDR }
-----------------------------------------------------------------------------
@@ -3534,7 +3529,6 @@ op :: { Located RdrName } -- used in infix decls
: varop { $1 }
| conop { $1 }
| '->' { sL1 $1 $ getRdrName funTyCon }
- | '~' { sL1 $1 $ eqTyCon_RDR }
varop :: { Located RdrName }
: varsym { $1 }
@@ -3597,10 +3591,6 @@ var :: { Located RdrName }
| '(' varsym ')' {% ams (sLL $1 $> (unLoc $2))
[mop $1,mj AnnVal $2,mcp $3] }
- -- Lexing type applications depends subtly on what characters can possibly
- -- end a qvar. Currently (June 2015), only $idchars and ")" can end a qvar.
- -- If you're changing this, please see Note [Lexing type applications] in
- -- Lexer.x.
qvar :: { Located RdrName }
: qvarid { $1 }
| '(' varsym ')' {% ams (sLL $1 $> (unLoc $2))
@@ -3677,8 +3667,7 @@ special_id
| 'signature' { sL1 $1 (fsLit "signature") }
special_sym :: { Located FastString }
-special_sym : '!' {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
- | '.' { sL1 $1 (fsLit ".") }
+special_sym : '.' { sL1 $1 (fsLit ".") }
| '*' { sL1 $1 (fsLit (starSym (isUnicode $1))) }
-----------------------------------------------------------------------------
@@ -3805,8 +3794,6 @@ getPRIMINTEGER (dL->L _ (ITprimint _ x)) = x
getPRIMWORD (dL->L _ (ITprimword _ x)) = x
getPRIMFLOAT (dL->L _ (ITprimfloat x)) = x
getPRIMDOUBLE (dL->L _ (ITprimdouble x)) = x
-getTH_ID_SPLICE (dL->L _ (ITidEscape x)) = x
-getTH_ID_TY_SPLICE (dL->L _ (ITidTyEscape x)) = x
getINLINE (dL->L _ (ITinline_prag _ inl conl)) = (inl,conl)
getSPEC_INLINE (dL->L _ (ITspec_inline_prag _ True)) = (Inline, FunLike)
getSPEC_INLINE (dL->L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)
@@ -4015,10 +4002,6 @@ in ApiAnnotation.hs
mj :: HasSrcSpan e => AnnKeywordId -> e -> AddAnn
mj a l = AddAnn a (gl l)
-mjL :: AnnKeywordId -> SrcSpan -> AddAnn
-mjL = AddAnn
-
-
-- |Construct an AddAnn from the annotation keyword and the Located Token. If
-- the token has a unicode equivalent and this has been used, provide the
@@ -4101,12 +4084,12 @@ mcs ll = mj AnnCloseS ll
-- |Given a list of the locations of commas, provide a [AddAnn] with an AnnComma
-- entry for each SrcSpan
mcommas :: [SrcSpan] -> [AddAnn]
-mcommas ss = map (mjL AnnCommaTuple) ss
+mcommas = map (AddAnn AnnCommaTuple)
-- |Given a list of the locations of '|'s, provide a [AddAnn] with an AnnVbar
-- entry for each SrcSpan
mvbars :: [SrcSpan] -> [AddAnn]
-mvbars ss = map (mjL AnnVbar) ss
+mvbars = map (AddAnn AnnVbar)
-- |Get the location of the last element of a OrdList, or noSrcSpan
oll :: HasSrcSpan a => OrdList a -> SrcSpan
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index cb70078fd3..9cccc7d1c0 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -56,8 +56,6 @@ module RdrHsSyn (
checkContext, -- HsType -> P HsContext
checkPattern, -- HsExp -> P HsPat
checkPattern_msg,
- isBangRdr,
- isTildeRdr,
checkMonadComp, -- P (HsStmtContext RdrName)
checkValDef, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
checkValSigLhs,
@@ -68,6 +66,7 @@ module RdrHsSyn (
checkEmptyGADTs,
addFatalError, hintBangPat,
TyEl(..), mergeOps, mergeDataCon,
+ mkBangTy,
-- Help with processing exports
ImpExpSubSpec(..),
@@ -100,7 +99,6 @@ module RdrHsSyn (
ecpFromExp,
ecpFromCmd,
PatBuilder,
- patBuilderBang,
) where
@@ -350,7 +348,7 @@ mkSpliceDecl lexpr@(dL->L loc expr)
= SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)
| otherwise
- = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice NoParens lexpr))
+ = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice BareSplice lexpr))
ImplicitSplice)
mkRoleAnnotDecl :: SrcSpan
@@ -564,14 +562,13 @@ declarations and types as a reversed list of TyEl:
data TyEl = TyElOpr RdrName
| TyElOpd (HsType GhcPs)
- | TyElBang | TyElTilde
| ...
For example, both occurences of (C ! D) in the following example are parsed
into equal lists of TyEl:
data T = C ! D => C ! D results in [ TyElOpd (HsTyVar "D")
- , TyElBang
+ , TyElOpr "!"
, TyElOpd (HsTyVar "C") ]
Note that elements are in reverse order. Also, 'C' is parsed as a type
@@ -1088,12 +1085,6 @@ checkPat loc (dL->L l e@(PatBuilderVar (dL->L _ c))) args
| not (null args) && patIsRec c =
localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
patFail l (ppr e)
-checkPat loc e args -- OK to let this happen even if bang-patterns
- -- are not enabled, because there is no valid
- -- non-bang-pattern parse of (C ! e)
- | Just (e', args') <- splitBang e
- = do { args'' <- mapM checkLPat args'
- ; checkPat loc e' (args'' ++ args) }
checkPat loc (dL->L _ (PatBuilderApp f e)) args
= do p <- checkLPat e
checkPat loc f (p : args)
@@ -1115,12 +1106,6 @@ checkAPat loc e0 = do
-- NB. Negative *primitive* literals are already handled by the lexer
PatBuilderOverLit pos_lit -> return (mkNPat (cL loc pos_lit) Nothing)
- PatBuilderBang lb e -- (! x)
- -> do { hintBangPat loc e0
- ; e' <- checkLPat e
- ; addAnnotation loc AnnBang lb
- ; return (BangPat noExtField e') }
-
-- n+k patterns
PatBuilderOpApp
(dL->L nloc (PatBuilderVar (dL->L _ n)))
@@ -1148,11 +1133,6 @@ plus_RDR, pun_RDR :: RdrName
plus_RDR = mkUnqual varName (fsLit "+") -- Hack
pun_RDR = mkUnqual varName (fsLit "pun-right-hand-side")
-isBangRdr, isTildeRdr :: RdrName -> Bool
-isBangRdr (Unqual occ) = occNameFS occ == fsLit "!"
-isBangRdr _ = False
-isTildeRdr = (==eqTyCon_RDR)
-
checkPatField :: LHsRecField GhcPs (Located (PatBuilder GhcPs))
-> PV (LHsRecField GhcPs (LPat GhcPs))
checkPatField (dL->L l fld) = do p <- checkLPat (hsRecFieldArg fld)
@@ -1167,22 +1147,21 @@ patIsRec e = e == mkUnqual varName (fsLit "rec")
---------------------------------------------------------------------------
-- Check Equation Syntax
-checkValDef :: SrcStrictness
- -> Located (PatBuilder GhcPs)
+checkValDef :: Located (PatBuilder GhcPs)
-> Maybe (LHsType GhcPs)
-> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
-> P ([AddAnn],HsBind GhcPs)
-checkValDef _strictness lhs (Just sig) grhss
+checkValDef lhs (Just sig) grhss
-- x :: ty = rhs parses as a *pattern* binding
= do lhs' <- runPV $ mkHsTySigPV (combineLocs lhs sig) lhs sig >>= checkLPat
checkPatBind lhs' grhss
-checkValDef strictness lhs Nothing g@(dL->L l (_,grhss))
+checkValDef lhs Nothing g@(dL->L l (_,grhss))
= do { mb_fun <- isFunLhs lhs
; case mb_fun of
Just (fun, is_infix, pats, ann) ->
- checkFunBind strictness ann (getLoc lhs)
+ checkFunBind NoSrcStrict ann (getLoc lhs)
fun is_infix pats (cL l grhss)
Nothing -> do
lhs' <- checkPattern lhs
@@ -1222,9 +1201,22 @@ makeFunBind fn ms
fun_co_fn = idHsWrapper,
fun_tick = [] }
+-- See Note [FunBind vs PatBind]
checkPatBind :: LPat GhcPs
-> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
-> P ([AddAnn],HsBind GhcPs)
+checkPatBind lhs (dL->L match_span (_,grhss))
+ | BangPat _ p <- unLoc lhs
+ , VarPat _ v <- unLoc p
+ = return ([], makeFunBind v [cL match_span (m v)])
+ where
+ m v = Match { m_ext = noExtField
+ , m_ctxt = FunRhs { mc_fun = cL (getLoc lhs) (unLoc v)
+ , mc_fixity = Prefix
+ , mc_strictness = SrcStrict }
+ , m_pats = []
+ , m_grhss = grhss }
+
checkPatBind lhs (dL->L _ (_,grhss))
= return ([],PatBind noExtField lhs grhss ([],[]))
@@ -1278,21 +1270,6 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
text "then" <+> ppr thenExpr <> pprOptSemi semiElse <+>
text "else" <+> ppr elseExpr
-
- -- The parser left-associates, so there should
- -- not be any OpApps inside the e's
-splitBang :: Located (PatBuilder GhcPs) -> Maybe (Located (PatBuilder GhcPs), [Located (PatBuilder GhcPs)])
--- Splits (f ! g a b) into (f, [(! g), a, b])
-splitBang (dL->L _ (PatBuilderOpApp l_arg op r_arg))
- | isBangRdr (unLoc op)
- = Just (l_arg, cL l' (PatBuilderBang (getLoc op) arg1) : argns)
- where
- l' = combineLocs op arg1
- (arg1,argns) = split_bang r_arg []
- split_bang (dL->L _ (PatBuilderApp f e)) es = split_bang f (e:es)
- split_bang e es = (e,es)
-splitBang _ = Nothing
-
-- See Note [isFunLhs vs mergeDataCon]
isFunLhs :: Located (PatBuilder GhcPs)
-> P (Maybe (Located RdrName, LexicalFixity, [Located (PatBuilder GhcPs)],[AddAnn]))
@@ -1314,31 +1291,7 @@ isFunLhs e = go e [] []
| not (isRdrDataCon f) = return (Just (cL loc f, Prefix, es, ann))
go (dL->L _ (PatBuilderApp f e)) es ann = go f (e:es) ann
go (dL->L l (PatBuilderPar e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
-
- -- Things of the form `!x` are also FunBinds
- -- See Note [FunBind vs PatBind]
- go (dL->L _ (PatBuilderBang _ (L _ (PatBuilderVar (dL -> L l var))))) [] ann
- | not (isRdrDataCon var) = return (Just (cL l var, Prefix, [], ann))
-
- -- For infix function defns, there should be only one infix *function*
- -- (though there may be infix *datacons* involved too). So we don't
- -- need fixity info to figure out which function is being defined.
- -- a `K1` b `op` c `K2` d
- -- must parse as
- -- (a `K1` b) `op` (c `K2` d)
- -- The renamer checks later that the precedences would yield such a parse.
- --
- -- There is a complication to deal with bang patterns.
- --
- -- ToDo: what about this?
- -- x + 1 `op` y = ...
-
- go e@(L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
- | Just (e',es') <- splitBang e
- = do { bang_on <- getBit BangPatBit
- ; if bang_on then go e' (es' ++ es) ann
- else return (Just (cL loc' op, Infix, (l:r:es), ann)) }
- -- No bangs; behave just like the next case
+ go (dL->L loc (PatBuilderOpApp l (dL->L loc' op) r)) es ann
| not (isRdrDataCon op) -- We have found the function!
= return (Just (cL loc' op, Infix, (l:r:es), ann))
| otherwise -- Infix data con; keep going
@@ -1356,7 +1309,6 @@ isFunLhs e = go e [] []
data TyEl = TyElOpr RdrName | TyElOpd (HsType GhcPs)
| TyElKindApp SrcSpan (LHsType GhcPs)
-- See Note [TyElKindApp SrcSpan interpretation]
- | TyElTilde | TyElBang
| TyElUnpackedness ([AddAnn], SourceText, SrcUnpackedness)
| TyElDocPrev HsDocString
@@ -1379,40 +1331,22 @@ instance Outputable TyEl where
ppr (TyElOpr name) = ppr name
ppr (TyElOpd ty) = ppr ty
ppr (TyElKindApp _ ki) = text "@" <> ppr ki
- ppr TyElTilde = text "~"
- ppr TyElBang = text "!"
ppr (TyElUnpackedness (_, _, unpk)) = ppr unpk
ppr (TyElDocPrev doc) = ppr doc
-tyElStrictness :: TyEl -> Maybe (AnnKeywordId, SrcStrictness)
-tyElStrictness TyElTilde = Just (AnnTilde, SrcLazy)
-tyElStrictness TyElBang = Just (AnnBang, SrcStrict)
-tyElStrictness _ = Nothing
-
-- | Extract a strictness/unpackedness annotation from the front of a reversed
-- 'TyEl' list.
-pStrictMark
+pUnpackedness
:: [Located TyEl] -- reversed TyEl
- -> Maybe ( Located HsSrcBang {- a strictness/upnackedness marker -}
+ -> Maybe ( SrcSpan
, [AddAnn]
+ , SourceText
+ , SrcUnpackedness
, [Located TyEl] {- remaining TyEl -})
-pStrictMark ((dL->L l1 x1) : (dL->L l2 x2) : xs)
- | Just (strAnnId, str) <- tyElStrictness x1
- , TyElUnpackedness (unpkAnns, prag, unpk) <- x2
- = Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)
- , unpkAnns ++ [AddAnn strAnnId l1]
- , xs )
-pStrictMark ((dL->L l x1) : xs)
- | Just (strAnnId, str) <- tyElStrictness x1
- = Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)
- , [AddAnn strAnnId l]
- , xs )
-pStrictMark ((dL->L l x1) : xs)
+pUnpackedness ((dL->L l x1) : xs)
| TyElUnpackedness (anns, prag, unpk) <- x1
- = Just ( cL l (HsSrcBang prag unpk NoSrcStrict)
- , anns
- , xs )
-pStrictMark _ = Nothing
+ = Just (l, anns, prag, unpk, xs)
+pUnpackedness _ = Nothing
pBangTy
:: LHsType GhcPs -- a type to be wrapped inside HsBangTy
@@ -1422,13 +1356,24 @@ pBangTy
, P () {- add annotations -}
, [Located TyEl] {- remaining TyEl -})
pBangTy lt@(dL->L l1 _) xs =
- case pStrictMark xs of
+ case pUnpackedness xs of
Nothing -> (False, lt, pure (), xs)
- Just (dL->L l2 strictMark, anns, xs') ->
+ Just (l2, anns, prag, unpk, xs') ->
let bl = combineSrcSpans l1 l2
- bt = HsBangTy noExtField strictMark lt
+ bt = addUnpackedness (prag, unpk) lt
in (True, cL bl bt, addAnnsAt bl anns, xs')
+mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs
+mkBangTy strictness =
+ HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness)
+
+addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs
+addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t))
+ | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang
+ = HsBangTy x (HsSrcBang prag unpk strictness) t
+addUnpackedness (prag, unpk) t
+ = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t
+
-- | Merge a /reversed/ and /non-empty/ soup of operators and operands
-- into a type.
--
@@ -1479,26 +1424,6 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
go _ _ _ ((dL->L l (TyElDocPrev _)):_) =
failOpDocPrev l
- -- to improve error messages, we do a bit of guesswork to determine if the
- -- user intended a '!' or a '~' as a strictness annotation
- go k acc ops_acc ((dL->L l x) : xs)
- | Just (_, str) <- tyElStrictness x
- , let guess [] = True
- guess ((dL->L _ (TyElOpd _)):_) = False
- guess ((dL->L _ (TyElOpr _)):_) = True
- guess ((dL->L _ (TyElKindApp _ _)):_) = False
- guess ((dL->L _ (TyElTilde)):_) = True
- guess ((dL->L _ (TyElBang)):_) = True
- guess ((dL->L _ (TyElUnpackedness _)):_) = True
- guess ((dL->L _ (TyElDocPrev _)):xs') = guess xs'
- guess _ = panic "mergeOps.go.guess: Impossible Match"
- -- due to #15884
- in guess xs
- = if not (null acc) && (k > 1 || length acc > 1)
- then do { a <- eitherToP (mergeOpsAcc acc)
- ; failOpStrictnessCompound (cL l str) (ops_acc a) }
- else failOpStrictnessPosition (cL l str)
-
-- clause [opr]:
-- when we encounter an operator, we must have accumulated
-- something for its rhs, and there must be something left
@@ -1512,16 +1437,6 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
isTyElOpd (dL->L _ (TyElOpd _)) = True
isTyElOpd _ = False
- -- clause [opr.1]: interpret 'TyElTilde' as an operator
- go k acc ops_acc ((dL->L l TyElTilde):xs) =
- let op = eqTyCon_RDR
- in go k acc ops_acc (cL l (TyElOpr op):xs)
-
- -- clause [opr.2]: interpret 'TyElBang' as an operator
- go k acc ops_acc ((dL->L l TyElBang):xs) =
- let op = mkUnqual tcClsName (fsLit "!")
- in go k acc ops_acc (cL l (TyElOpr op):xs)
-
-- clause [opd]:
-- whenever an operand is encountered, it is added to the accumulator
go k acc ops_acc ((dL->L l (TyElOpd a)):xs) = go k (HsValArg (cL l a):acc) ops_acc xs
@@ -1700,7 +1615,7 @@ This approach does not suffer from the issues of 'isFunLhs':
-- into a data constructor.
--
-- User input: @C !A B -- ^ doc@
--- Input to 'mergeDataCon': ["doc", B, !, A, C]
+-- Input to 'mergeDataCon': ["doc", B, !A, C]
-- Output: (C, PrefixCon [!A, B], "doc")
--
-- See Note [Parsing data constructors is hard]
@@ -1950,6 +1865,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
mkHsAsPatPV :: SrcSpan -> Located RdrName -> Located b -> PV (Located b)
-- | Disambiguate "~a" (lazy pattern)
mkHsLazyPatPV :: SrcSpan -> Located b -> PV (Located b)
+ -- | Disambiguate "!a" (bang pattern)
+ mkHsBangPatPV :: SrcSpan -> Located b -> PV (Located b)
-- | Disambiguate tuple sections and unboxed sums
mkSumOrTuplePV :: SrcSpan -> Boxity -> SumOrTuple b -> PV (Located b)
@@ -2039,6 +1956,8 @@ instance p ~ GhcPs => DisambECP (HsCmd p) where
pprPrefixOcc (unLoc v) <> text "@" <> ppr c
mkHsLazyPatPV l c = cmdFail l $
text "~" <> ppr c
+ mkHsBangPatPV l c = cmdFail l $
+ text "!" <> ppr c
mkSumOrTuplePV l boxity a = cmdFail l (pprSumOrTuple boxity a)
cmdFail :: SrcSpan -> SDoc -> PV a
@@ -2083,21 +2002,20 @@ instance p ~ GhcPs => DisambECP (HsExpr p) where
checkRecordSyntax (cL l r)
mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr)
mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e)
- mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty
- mkHsAsPatPV l v e = do
- opt_TypeApplications <- getBit TypeApplicationsBit
- let msg | opt_TypeApplications
- = "Type application syntax requires a space before '@'"
- | otherwise
- = "Did you mean to enable TypeApplications?"
- patSynErr l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) (text msg)
- mkHsLazyPatPV l e = patSynErr l (text "~" <> ppr e) empty
+ mkHsViewPatPV l a b = patSynErr "View pattern" l (ppr a <+> text "->" <+> ppr b) empty
+ mkHsAsPatPV l v e =
+ patSynErr "@-pattern" l (pprPrefixOcc (unLoc v) <> text "@" <> ppr e) $
+ text "Type application syntax requires a space before '@'"
+ mkHsLazyPatPV l e = patSynErr "Lazy pattern" l (text "~" <> ppr e) $
+ text "Did you mean to add a space after the '~'?"
+ mkHsBangPatPV l e = patSynErr "Bang pattern" l (text "!" <> ppr e) $
+ text "Did you mean to add a space after the '!'?"
mkSumOrTuplePV = mkSumOrTupleExpr
-patSynErr :: SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
-patSynErr l e explanation =
+patSynErr :: String -> SrcSpan -> SDoc -> SDoc -> PV (LHsExpr GhcPs)
+patSynErr item l e explanation =
do { addError l $
- sep [text "Pattern syntax in expression context:",
+ sep [text item <+> text "in expression context:",
nest 4 (ppr e)] $$
explanation
; return (cL l hsHoleExpr) }
@@ -2108,21 +2026,14 @@ hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
data PatBuilder p
= PatBuilderPat (Pat p)
- | PatBuilderBang SrcSpan (Located (PatBuilder p))
| PatBuilderPar (Located (PatBuilder p))
| PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
| PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
| PatBuilderVar (Located RdrName)
| PatBuilderOverLit (HsOverLit GhcPs)
-patBuilderBang :: SrcSpan -> Located (PatBuilder p) -> Located (PatBuilder p)
-patBuilderBang bang p =
- cL (bang `combineSrcSpans` getLoc p) $
- PatBuilderBang bang p
-
instance Outputable (PatBuilder GhcPs) where
ppr (PatBuilderPat p) = ppr p
- ppr (PatBuilderBang _ (L _ p)) = text "!" <+> ppr p
ppr (PatBuilderPar (L _ p)) = parens (ppr p)
ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
ppr (PatBuilderOpApp (L _ p1) op (L _ p2)) = ppr p1 <+> ppr op <+> ppr p2
@@ -2143,9 +2054,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp m = m
- mkHsOpAppPV l p1 op p2 = do
- warnSpaceAfterBang op (getLoc p2)
- return $ cL l $ PatBuilderOpApp p1 op p2
+ mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2
mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
superFunArg m = m
@@ -2174,9 +2083,7 @@ instance DisambECP (PatBuilder GhcPs) where
PatBuilderOverLit pos_lit -> return (cL lp pos_lit)
_ -> patFail l (text "-" <> ppr p)
return $ cL l (PatBuilderPat (mkNPat lit (Just noSyntaxExpr)))
- mkHsSectionR_PV l op p
- | isBangRdr (unLoc op) = return $ cL l $ PatBuilderBang (getLoc op) p
- | otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p)
+ mkHsSectionR_PV l op p = patFail l (pprInfixOcc (unLoc op) <> ppr p)
mkHsViewPatPV l a b = do
p <- checkLPat b
return $ cL l (PatBuilderPat (ViewPat noExtField a p))
@@ -2186,6 +2093,11 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsLazyPatPV l e = do
p <- checkLPat e
return $ cL l (PatBuilderPat (LazyPat noExtField p))
+ mkHsBangPatPV l e = do
+ p <- checkLPat e
+ let pb = BangPat noExtField p
+ hintBangPat l pb
+ return $ cL l (PatBuilderPat pb)
mkSumOrTuplePV = mkSumOrTuplePat
checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
@@ -2206,19 +2118,6 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
mkPatRec p _ =
addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
--- | Warn about missing space after bang
-warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV ()
-warnSpaceAfterBang (dL->L opLoc op) argLoc = do
- bang_on <- getBit BangPatBit
- when (not bang_on && noSpace && isBangRdr op) $
- addWarning Opt_WarnSpaceAfterBang span msg
- where
- span = combineSrcSpans opLoc argLoc
- noSpace = srcSpanEnd opLoc == srcSpanStart argLoc
- msg = text "Did you forget to enable BangPatterns?" $$
- text "If you mean to bind (!) then perhaps you want" $$
- text "to add a space after the bang for clarity."
-
{- Note [Ambiguous syntactic categories]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -3014,18 +2913,6 @@ failOpDocPrev loc = addFatalError loc msg
where
msg = text "Unexpected documentation comment."
-failOpStrictnessCompound :: Located SrcStrictness -> LHsType GhcPs -> P a
-failOpStrictnessCompound (dL->L _ str) (dL->L loc ty) = addFatalError loc msg
- where
- msg = text "Strictness annotation applied to a compound type." $$
- text "Did you mean to add parentheses?" $$
- nest 2 (ppr str <> parens (ppr ty))
-
-failOpStrictnessPosition :: Located SrcStrictness -> P a
-failOpStrictnessPosition (dL->L loc _) = addFatalError loc msg
- where
- msg = text "Strictness annotation cannot appear in this position."
-
-----------------------------------------------------------------------------
-- Misc utils
@@ -3191,11 +3078,11 @@ no effect on the error messages.
-}
-- | Hint about bang patterns, assuming @BangPatterns@ is off.
-hintBangPat :: SrcSpan -> PatBuilder GhcPs -> PV ()
+hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat span e = do
bang_on <- getBit BangPatBit
unless bang_on $
- addFatalError span
+ addError span
(text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
data SumOrTuple b
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index b1ba7bf4b2..de7ec7ec81 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -260,6 +260,27 @@ eqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~") eqTyConK
eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon
eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId
+{- Note [eqTyCon (~) is built-in syntax]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The (~) type operator used in equality constraints (a~b) is considered built-in
+syntax. This has a few consequences:
+
+* The user is not allowed to define their own type constructors with this name:
+
+ ghci> class a ~ b
+ <interactive>:1:1: error: Illegal binding of built-in syntax: ~
+
+* Writing (a ~ b) does not require enabling -XTypeOperators. It does, however,
+ require -XGADTs or -XTypeFamilies.
+
+* The (~) type operator is always in scope. It doesn't need to be be imported,
+ and it cannot be hidden.
+
+* We have a bunch of special cases in the compiler to arrange all of the above.
+
+There's no particular reason for (~) to be special, but fixing this would be a
+breaking change.
+-}
eqTyCon_RDR :: RdrName
eqTyCon_RDR = nameRdrName eqTyConName
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index c84e7bd328..586548f5d8 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1555,7 +1555,13 @@ dataTcOccs rdr_name
= [rdr_name]
where
occ = rdrNameOcc rdr_name
- rdr_name_tc = setRdrNameSpace rdr_name tcName
+ rdr_name_tc =
+ case rdr_name of
+ -- The (~) type operator is always in scope, so we need a special case
+ -- for it here, or else :info (~) fails in GHCi.
+ -- See Note [eqTyCon (~) is built-in syntax]
+ Unqual occ | occNameFS occ == fsLit "~" -> eqTyCon_RDR
+ _ -> setRdrNameSpace rdr_name tcName
{-
Note [dataTcOccs and Exact Names]
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 3e6d64751d..d9cc28ee7b 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -753,7 +753,7 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
spliceDebugDoc loc
= let code = case mb_src of
Nothing -> ending
- Just e -> nest 2 (ppr e) : ending
+ Just e -> nest 2 (ppr (stripParensHsExpr e)) : ending
ending = [ text "======>", nest 2 gen ]
in hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
2 (sep code)
diff --git a/docs/users_guide/bugs.rst b/docs/users_guide/bugs.rst
index c0cffa0ee8..4dc49f0328 100644
--- a/docs/users_guide/bugs.rst
+++ b/docs/users_guide/bugs.rst
@@ -49,6 +49,45 @@ Lexical syntax
reserving ``forall`` as a keyword has significance. For instance, GHC will
not parse the type signature ``foo :: forall x``.
+- The ``(!)`` operator, when written in prefix form (preceded by whitespace
+ and not followed by whitespace, as in ``f !x = ...``), is interpreted as a
+ bang pattern, contrary to the Haskell Report, which prescribes to treat ``!``
+ as an operator regardless of surrounding whitespace. Note that this does not
+ imply that GHC always enables :extension:`BangPatterns`. Without the
+ extension, GHC will issue a parse error on ``f !x``, asking to enable the
+ extension.
+
+- Irrefutable patterns must be written in prefix form::
+
+ f ~a ~b = ... -- accepted by both GHC and the Haskell Report
+ f ~ a ~ b = ... -- accepted by the Haskell Report but not GHC
+
+ When written in non-prefix form, ``(~)`` is treated by GHC as a regular
+ infix operator.
+
+ See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+ for the precise rules.
+
+- Strictness annotations in data declarations must be written in prefix form::
+
+ data T = MkT !Int -- accepted by both GHC and the Haskell Report
+ data T = MkT ! Int -- accepted by the Haskell Report but not GHC
+
+ See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+ for the precise rules.
+
+- As-patterns must not be surrounded by whitespace::
+
+ f p@(x, y, z) = ... -- accepted by both GHC and the Haskell Report
+ f p @ (x, y, z) = ... -- accepted by the Haskell Report but not GHC
+
+ When surrounded by whitespace, ``(@)`` is treated by GHC as a regular infix
+ operator.
+
+ See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+ for the precise rules.
+
+
.. _infelicities-syntax:
Context-free syntax
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index af3d48e0a3..d23681e0b3 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -13108,10 +13108,9 @@ enable the quotation subset of Template Haskell (i.e. without splice syntax).
The :extension:`TemplateHaskellQuotes` extension is considered safe under
:ref:`safe-haskell` while :extension:`TemplateHaskell` is not.
-- A splice is written ``$x``, where ``x`` is an identifier, or
- ``$(...)``, where the "..." is an arbitrary expression. There must be
- no space between the "$" and the identifier or parenthesis. This use
- of "$" overrides its meaning as an infix operator, just as "M.x"
+- A splice is written ``$x``, where ``x`` is an arbitrary expression.
+ There must be no space between the "$" and the expression.
+ This use of "$" overrides its meaning as an infix operator, just as "M.x"
overrides the meaning of "." as an infix operator. If you want the
infix operator, put spaces around it.
@@ -13147,9 +13146,8 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
See :ref:`pts-where` for using partial type signatures in quotations.
-- A *typed* expression splice is written ``$$x``, where ``x`` is an
- identifier, or ``$$(...)``, where the "..." is an arbitrary
- expression.
+- A *typed* expression splice is written ``$$x``, where ``x`` is
+ is an arbitrary expression.
A typed expression splice can occur in place of an expression; the
spliced expression must have type ``Q (TExp a)``
@@ -14323,12 +14321,15 @@ Note the following points:
f !x = 3
- Is this a definition of the infix function "``(!)``", or of the "``f``"
- with a bang pattern? GHC resolves this ambiguity in favour of the
- latter. If you want to define ``(!)`` with bang-patterns enabled, you
- have to do so using prefix notation: ::
+ Is this a definition of the infix function "``(!)``", or of the "``f``" with
+ a bang pattern? GHC resolves this ambiguity by looking at the surrounding
+ whitespace: ::
- (!) f x = 3
+ a ! b = ... -- infix operator
+ a !b = ... -- bang pattern
+
+ See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+ for the precise rules.
.. _strict-data:
@@ -14359,6 +14360,13 @@ we interpret it as if they had written ::
The extension only affects definitions in this module.
+The ``~`` annotation must be written in prefix form::
+
+ data T = MkT ~Int -- valid
+ data T = MkT ~ Int -- invalid
+
+See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+for the precise rules.
.. _strict:
@@ -14393,7 +14401,7 @@ optionally had by adding ``!`` in front of a variable.
Adding ``~`` in front of ``x`` gives the regular lazy behavior.
- Turning patterns into irrefutable ones requires ``~(~p)`` or ``(~ ~p)`` when ``Strict`` is enabled.
+ Turning patterns into irrefutable ones requires ``~(~p)`` when ``Strict`` is enabled.
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 62b644aa8a..4649f86de0 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -46,7 +46,6 @@ generally likely to indicate bugs in your program. These are:
* :ghc-flag:`-Winaccessible-code`
* :ghc-flag:`-Wstar-is-type`
* :ghc-flag:`-Wstar-binder`
- * :ghc-flag:`-Wspace-after-bang`
The following flags are simple ways to select standard "packages" of warnings:
@@ -1280,12 +1279,6 @@ of ``-W(no-)*``.
per-module basis with :ghc-flag:`-Wno-simplifiable-class-constraints
<-Wsimplifiable-class-constraints>`.
-.. ghc-flag:: -Wspace-after-bang
- :shortdesc: warn for missing space before the second argument
- of an infix definition of ``(!)`` when
- :extension:`BangPatterns` are not enabled
- :type: dynamic
- :reverse: -Wno-missing-space-after-bang
.. ghc-flag:: -Wtabs
:shortdesc: warn if there are tabs in the source file
:type: dynamic
diff --git a/nofib b/nofib
-Subproject a6cbac8fd8c69d85fddfde0a2686607e1ae2294
+Subproject c9fe4e92b88cd052d5fea8b713569d16c05ebf0
diff --git a/testsuite/tests/ghc-api/annotations/T10268.stdout b/testsuite/tests/ghc-api/annotations/T10268.stdout
index 3739b7b0b7..502d5fcf47 100644
--- a/testsuite/tests/ghc-api/annotations/T10268.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10268.stdout
@@ -14,7 +14,7 @@
((Test10268.hs:5:1-17,AnnEqual), [Test10268.hs:5:4]),
((Test10268.hs:5:1-17,AnnFunId), [Test10268.hs:5:1-2]),
((Test10268.hs:5:1-17,AnnSemi), [Test10268.hs:7:1]),
-((Test10268.hs:5:6-17,AnnThIdSplice), [Test10268.hs:5:6-17]),
+((Test10268.hs:5:6-17,AnnDollar), [Test10268.hs:5:6]),
((Test10268.hs:7:1-27,AnnDcolon), [Test10268.hs:7:6-7]),
((Test10268.hs:7:1-27,AnnSemi), [Test10268.hs:8:1]),
((Test10268.hs:7:9,AnnRarrow), [Test10268.hs:7:11-12]),
diff --git a/testsuite/tests/ghc-api/annotations/T10276.stdout b/testsuite/tests/ghc-api/annotations/T10276.stdout
index 2ed6318905..77b2dae7a2 100644
--- a/testsuite/tests/ghc-api/annotations/T10276.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10276.stdout
@@ -29,8 +29,9 @@
((Test10276.hs:(10,13)-(11,74),AnnClose), [Test10276.hs:11:72-74]),
((Test10276.hs:(10,13)-(11,74),AnnOpen), [Test10276.hs:10:13-15]),
((Test10276.hs:(10,16)-(11,71),AnnVal), [Test10276.hs:10:20]),
-((Test10276.hs:10:31-42,AnnCloseP), [Test10276.hs:10:42]),
-((Test10276.hs:10:31-42,AnnOpenPTE), [Test10276.hs:10:31-33]),
+((Test10276.hs:10:31-42,AnnDollarDollar), [Test10276.hs:10:31-32]),
+((Test10276.hs:10:33-42,AnnCloseP), [Test10276.hs:10:42]),
+((Test10276.hs:10:33-42,AnnOpenP), [Test10276.hs:10:33]),
((Test10276.hs:11:25-71,AnnCloseP), [Test10276.hs:11:71]),
((Test10276.hs:11:25-71,AnnOpenP), [Test10276.hs:11:25]),
((Test10276.hs:11:26-36,AnnCloseP), [Test10276.hs:11:36]),
@@ -50,8 +51,9 @@
((Test10276.hs:(14,13)-(15,74),AnnClose), [Test10276.hs:15:72-74]),
((Test10276.hs:(14,13)-(15,74),AnnOpenE), [Test10276.hs:14:13-16]),
((Test10276.hs:(14,17)-(15,71),AnnVal), [Test10276.hs:14:21]),
-((Test10276.hs:14:32-43,AnnCloseP), [Test10276.hs:14:43]),
-((Test10276.hs:14:32-43,AnnOpenPTE), [Test10276.hs:14:32-34]),
+((Test10276.hs:14:32-43,AnnDollarDollar), [Test10276.hs:14:32-33]),
+((Test10276.hs:14:34-43,AnnCloseP), [Test10276.hs:14:43]),
+((Test10276.hs:14:34-43,AnnOpenP), [Test10276.hs:14:34]),
((Test10276.hs:15:25-71,AnnCloseP), [Test10276.hs:15:71]),
((Test10276.hs:15:25-71,AnnOpenP), [Test10276.hs:15:25]),
((Test10276.hs:15:26-36,AnnCloseP), [Test10276.hs:15:36]),
diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout
index 604c7dab36..28f516cb5e 100644
--- a/testsuite/tests/ghc-api/annotations/T10358.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10358.stdout
@@ -16,12 +16,12 @@
((Test10358.hs:(4,1)-(8,6),AnnSemi), [Test10358.hs:9:1]),
((Test10358.hs:(5,3)-(8,6),AnnIn), [Test10358.hs:8:3-4]),
((Test10358.hs:(5,3)-(8,6),AnnLet), [Test10358.hs:5:3-5]),
-((Test10358.hs:5:7-16,AnnBang), [Test10358.hs:5:7]),
+((Test10358.hs:5:7-10,AnnBang), [Test10358.hs:5:7]),
((Test10358.hs:5:7-16,AnnEqual), [Test10358.hs:5:12]),
((Test10358.hs:5:7-16,AnnFunId), [Test10358.hs:5:8-10]),
((Test10358.hs:5:7-16,AnnSemi), [Test10358.hs:5:17]),
((Test10358.hs:5:14-16,AnnVal), [Test10358.hs:5:15]),
-((Test10358.hs:5:19-32,AnnBang), [Test10358.hs:5:19]),
+((Test10358.hs:5:19-22,AnnBang), [Test10358.hs:5:19]),
((Test10358.hs:5:19-32,AnnEqual), [Test10358.hs:5:24]),
((Test10358.hs:5:19-32,AnnFunId), [Test10358.hs:5:20-22]),
((Test10358.hs:5:19-32,AnnSemi), [Test10358.hs:6:7]),
diff --git a/testsuite/tests/ghc-api/annotations/T10399.stdout b/testsuite/tests/ghc-api/annotations/T10399.stdout
index 75d94b3406..b1e5a34d8f 100644
--- a/testsuite/tests/ghc-api/annotations/T10399.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10399.stdout
@@ -82,12 +82,13 @@
((Test10399.hs:20:1-25,AnnCloseQ), [Test10399.hs:20:24-25]),
((Test10399.hs:20:1-25,AnnOpen), [Test10399.hs:20:1-3]),
((Test10399.hs:20:1-25,AnnSemi), [Test10399.hs:22:1]),
-((Test10399.hs:20:20-22,AnnThIdSplice), [Test10399.hs:20:20-22]),
+((Test10399.hs:20:20-22,AnnDollar), [Test10399.hs:20:20]),
((Test10399.hs:22:1-21,AnnEqual), [Test10399.hs:22:19]),
((Test10399.hs:22:1-21,AnnFunId), [Test10399.hs:22:1-3]),
((Test10399.hs:22:1-21,AnnSemi), [Test10399.hs:23:1]),
-((Test10399.hs:22:5-17,AnnCloseP), [Test10399.hs:22:17]),
-((Test10399.hs:22:5-17,AnnOpenPE), [Test10399.hs:22:5-6]),
+((Test10399.hs:22:5-17,AnnDollar), [Test10399.hs:22:5]),
+((Test10399.hs:22:6-17,AnnCloseP), [Test10399.hs:22:17]),
+((Test10399.hs:22:6-17,AnnOpenP), [Test10399.hs:22:6]),
((Test10399.hs:22:8-15,AnnCloseQ), [Test10399.hs:22:14-15]),
((Test10399.hs:22:8-15,AnnOpen), [Test10399.hs:22:8-10]),
((<no location info>,AnnEofPos), [Test10399.hs:23:1])
diff --git a/testsuite/tests/module/mod69.stderr b/testsuite/tests/module/mod69.stderr
index db7487485e..dea161115e 100644
--- a/testsuite/tests/module/mod69.stderr
+++ b/testsuite/tests/module/mod69.stderr
@@ -1,4 +1,4 @@
mod69.hs:3:7: error:
- Pattern syntax in expression context: x@1
- Did you mean to enable TypeApplications?
+ @-pattern in expression context: x@1
+ Type application syntax requires a space before '@'
diff --git a/testsuite/tests/module/mod70.stderr b/testsuite/tests/module/mod70.stderr
index 093f166ebd..6e9f854b7a 100644
--- a/testsuite/tests/module/mod70.stderr
+++ b/testsuite/tests/module/mod70.stderr
@@ -1,2 +1,4 @@
-mod70.hs:3:9: error: Pattern syntax in expression context: ~1
+mod70.hs:3:9: error:
+ Lazy pattern in expression context: ~1
+ Did you mean to add a space after the '~'?
diff --git a/testsuite/tests/overloadedrecflds/should_fail/T11103.stderr b/testsuite/tests/overloadedrecflds/should_fail/T11103.stderr
index b4f29fbfb7..09606e0557 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T11103.stderr
+++ b/testsuite/tests/overloadedrecflds/should_fail/T11103.stderr
@@ -1,6 +1,6 @@
-T11103.hs:13:3: error:
+T11103.hs:13:2: error:
Ambiguous occurrence ‘Main.foo’
- It could refer to either the field ‘foo’,
- defined at T11103.hs:11:16
- or the field ‘foo’, defined at T11103.hs:10:16
+ It could refer to
+ either the field ‘foo’, defined at T11103.hs:11:16
+ or the field ‘foo’, defined at T11103.hs:10:16
diff --git a/testsuite/tests/parser/should_compile/Proposal229f_instances.hs b/testsuite/tests/parser/should_compile/Proposal229f_instances.hs
new file mode 100644
index 0000000000..2bd5a8ee19
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/Proposal229f_instances.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Proposal229f_instances where
+
+import GHC.Exts
+import Data.String
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+instance IsList (Q (TExp String)) where
+ type Item (Q (TExp String)) = Char
+ fromList = liftTyped
+ toList = undefined
+
+instance IsList (Q Exp) where
+ type Item (Q Exp) = Char
+ fromList = lift
+ toList = undefined
+
+instance IsString (Q (TExp String)) where
+ fromString = liftTyped
+
+instance IsString (Q Exp) where
+ fromString = lift
diff --git a/testsuite/tests/parser/should_compile/T1087.hs b/testsuite/tests/parser/should_compile/T1087.hs
new file mode 100644
index 0000000000..9ad85e2b7a
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T1087.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T1087 where
+
+prefix_1 = let at a !b = False in at 1 2
+prefix_2 = let (.!.) a !b = False in 1 .!. 2
+
+infix_tilde_1 = let a `at` ~b = False in at 1 2
+infix_tilde_2 = let a .!. ~b = False in 1 .!. 2
+infix_tilde_3 = let ~a .!. b = False in 1 .!. 2
+
+infix_bang_1 = let a .!. !b = False in 1 .!. 2
+infix_bang_2 = let a `at` !b = False in at 1 2
+infix_bang_3 = let !a .!. b = False in 1 .!. 2
diff --git a/testsuite/tests/parser/should_compile/T16619.stderr b/testsuite/tests/parser/should_compile/T16619.stderr
new file mode 100644
index 0000000000..b5dfb89623
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T16619.stderr
@@ -0,0 +1,3 @@
+
+T16619.hs:2:12: warning:
+ -Wmissing-space-after-bang is deprecated: bang patterns can no longer be written with a space
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 3d44e22510..91aae139ab 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -145,3 +145,20 @@ test('T16339', normal, compile, [''])
test('T16619', req_th, multimod_compile, ['T16619', '-v0'])
test('T504', normal, compile, [''])
test('T515', literate, compile, ['-Wall'])
+test('T1087', normal, compile, [''])
+test('proposal-229a', normal, compile, [''])
+test('proposal-229b', normal, compile, [''])
+test('proposal-229d', normal, compile, [''])
+test('proposal-229e', normal, compile, [''])
+
+# We omit 'profasm' because it fails with:
+# Cannot load -prof objects when GHC is built with -dynamic
+# To fix this, either:
+# (1) Use -fexternal-interpreter, or
+# (2) Build the program twice: once with -dynamic, and then
+# with -prof using -osuf to set a different object file suffix.
+test('proposal-229f',
+ [ extra_files(['proposal-229f.hs', 'Proposal229f_instances.hs']),
+ omit_ways(['profasm', 'profthreaded'])
+ ],
+ multimod_compile_and_run, ['proposal-229f.hs', ''])
diff --git a/testsuite/tests/parser/should_compile/proposal-229a.hs b/testsuite/tests/parser/should_compile/proposal-229a.hs
new file mode 100644
index 0000000000..c773cee3a2
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229a.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229a where
+
+data T a b = a :! b
+
+(!) :: x -> T a b -> (x, a, b)
+~u ! !(!m :! !n) = (u, m, n)
diff --git a/testsuite/tests/parser/should_compile/proposal-229b.hs b/testsuite/tests/parser/should_compile/proposal-229b.hs
new file mode 100644
index 0000000000..9182623e54
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229b.hs
@@ -0,0 +1,10 @@
+module Proposal229b ((~), (@)) where
+
+(~) :: a -> b -> (a, b)
+x ~ y = (x, y)
+
+(@) :: a -> b -> (a, b)
+x @ y = (x, y)
+
+r :: ((Bool, Bool), Bool)
+r = True ~ False @ True
diff --git a/testsuite/tests/parser/should_compile/proposal-229d.hs b/testsuite/tests/parser/should_compile/proposal-229d.hs
new file mode 100644
index 0000000000..24a57ca872
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229d.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229d ((!)) where
+
+(!) :: a -> b -> (a, b)
+x ! y = (x,y) -- parsed as an operator even with BangPatterns enabled
diff --git a/testsuite/tests/parser/should_compile/proposal-229e.hs b/testsuite/tests/parser/should_compile/proposal-229e.hs
new file mode 100644
index 0000000000..d7fc35d38e
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229e.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Proposal229e ((!), f) where
+
+(!) :: Maybe a -> a -> (a, a)
+f :: a -> a
+
+-- the preceding '}' is not from a comment,
+-- so (!) is tight infix (therefore an operator)
+Nothing{}!x = (x, x)
+
+-- the following '{' opens a multi-line comment,
+-- so (!) is loose infix (therefore an operator)
+Just a !{-comment-}x = (a, x)
+
+-- the preceding '}' is closing a multi-line comment,
+-- so (!) is prefix (therefore a bang pattern)
+f{-comment-}!x = x
diff --git a/testsuite/tests/parser/should_compile/proposal-229f.hs b/testsuite/tests/parser/should_compile/proposal-229f.hs
new file mode 100644
index 0000000000..75b1341c6f
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229f.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+
+import System.IO
+import Proposal229f_instances
+
+-- Testing that we can parse $[...] and $"..."
+main = do
+ hPutStrLn stderr $['1','2','3']
+ hPutStrLn stderr $$['1','2','3']
+ hPutStrLn stderr $"123"
+ hPutStrLn stderr $$"123"
diff --git a/testsuite/tests/parser/should_compile/proposal-229f.stderr b/testsuite/tests/parser/should_compile/proposal-229f.stderr
new file mode 100644
index 0000000000..310be0621c
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/proposal-229f.stderr
@@ -0,0 +1,4 @@
+123
+123
+123
+123
diff --git a/testsuite/tests/parser/should_fail/T14588.stderr b/testsuite/tests/parser/should_fail/T14588.stderr
index cb64103814..2efd9561e8 100644
--- a/testsuite/tests/parser/should_fail/T14588.stderr
+++ b/testsuite/tests/parser/should_fail/T14588.stderr
@@ -1,4 +1,4 @@
T14588.hs:3:19: error:
Illegal bang-pattern (use BangPatterns):
- ! x
+ !x
diff --git a/testsuite/tests/parser/should_fail/T16270.stderr b/testsuite/tests/parser/should_fail/T16270.stderr
index f4e90e40fc..a74bdeb8f0 100644
--- a/testsuite/tests/parser/should_fail/T16270.stderr
+++ b/testsuite/tests/parser/should_fail/T16270.stderr
@@ -1,4 +1,7 @@
+T16270.hs:2:12: warning:
+ -Werror=missing-space-after-bang is deprecated: bang patterns can no longer be written with a space
+
T16270.hs:7:1: warning: [-Wtabs (in -Wdefault)]
Tab character found here, and in five further locations.
Please use spaces instead.
@@ -46,10 +49,9 @@ T16270.hs:23:10: error:
Perhaps you intended to use GADTs or a similar language
extension to enable syntax: data T where
-T16270.hs:25:12: error: [-Wmissing-space-after-bang (in -Wdefault), -Werror=missing-space-after-bang]
- Did you forget to enable BangPatterns?
- If you mean to bind (!) then perhaps you want
- to add a space after the bang for clarity.
+T16270.hs:25:12: error:
+ Illegal bang-pattern (use BangPatterns):
+ !i
T16270.hs:27:9: error:
Multi-way if-expressions need MultiWayIf turned on
@@ -57,13 +59,13 @@ T16270.hs:27:9: error:
T16270.hs:29:9: error:
Multi-way if-expressions need MultiWayIf turned on
-T16270.hs:32:6: Illegal lambda-case (use LambdaCase)
+T16270.hs:32:6: error: Illegal lambda-case (use LambdaCase)
-T16270.hs:35:5:
+T16270.hs:35:5: error:
Use NumericUnderscores to allow underscores in integer literals
-T16270.hs:37:5:
- primitive string literal must contain only characters <= '/xFF'
+T16270.hs:37:5: error:
+ primitive string literal must contain only characters <= '\xFF'
T16270.hs:43:1: error:
parse error (possibly incorrect indentation or mismatched brackets)
diff --git a/testsuite/tests/parser/should_fail/T17162.hs b/testsuite/tests/parser/should_fail/T17162.hs
new file mode 100644
index 0000000000..6419da7544
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17162.hs
@@ -0,0 +1,13 @@
+-- {-# LANGUAGE NoBangPatterns #-}
+
+module T17162 where
+
+charIsRepresentable :: TextEncoding -> Char -> IO Bool
+charIsRepresentable !enc c =
+ withCString enc [c]
+ (\cstr -> do str <- peekCString enc cstr
+ case str of
+ [ch] | ch == c -> pure True
+ _ -> pure False)
+ `catch`
+ \(_ :: IOException) -> pure False
diff --git a/testsuite/tests/parser/should_fail/T17162.stderr b/testsuite/tests/parser/should_fail/T17162.stderr
new file mode 100644
index 0000000000..d621e08ccc
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T17162.stderr
@@ -0,0 +1,4 @@
+
+T17162.hs:6:21: error:
+ Illegal bang-pattern (use BangPatterns):
+ !enc
diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr
index f4e44c603c..65de1d5a75 100644
--- a/testsuite/tests/parser/should_fail/T3811b.stderr
+++ b/testsuite/tests/parser/should_fail/T3811b.stderr
@@ -1,4 +1,4 @@
T3811b.hs:4:14: error:
Cannot parse data constructor in a data/newtype declaration:
- ! B
+ !B
diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr
index 431318e268..52f081bbe6 100644
--- a/testsuite/tests/parser/should_fail/T3811c.stderr
+++ b/testsuite/tests/parser/should_fail/T3811c.stderr
@@ -1,5 +1,6 @@
-T3811c.hs:6:11: error:
- Strictness annotation applied to a compound type.
- Did you mean to add parentheses?
- !(Show D)
+T3811c.hs:6:10: error:
+ Illegal class instance: ‘!Show D’
+ Class instances must be of the form
+ context => C ty_1 ... ty_n
+ where ‘C’ is a class
diff --git a/testsuite/tests/parser/should_fail/T3811f.stderr b/testsuite/tests/parser/should_fail/T3811f.stderr
index 2d31fa86cf..783a89e284 100644
--- a/testsuite/tests/parser/should_fail/T3811f.stderr
+++ b/testsuite/tests/parser/should_fail/T3811f.stderr
@@ -1,5 +1,3 @@
-T3811f.hs:4:8: error:
- Strictness annotation applied to a compound type.
- Did you mean to add parentheses?
- !(Foo a)
+T3811f.hs:4:7: error:
+ Malformed head of type or class declaration: !Foo a
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 2fc7f3d326..c4a7a4f67b 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -161,3 +161,5 @@ test('patFail006', normal, compile_fail, [''])
test('patFail007', normal, compile_fail, [''])
test('patFail008', normal, compile_fail, [''])
test('patFail009', normal, compile_fail, [''])
+test('T17162', normal, compile_fail, [''])
+test('proposal-229c', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_fail/proposal-229c.hs b/testsuite/tests/parser/should_fail/proposal-229c.hs
new file mode 100644
index 0000000000..344311b2a1
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/proposal-229c.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoBangPatterns #-}
+
+module Proposal229c (f) where
+
+-- should recommend to enable BangPatterns instead of parsing as an infix operator
+f !x = x
diff --git a/testsuite/tests/parser/should_fail/proposal-229c.stderr b/testsuite/tests/parser/should_fail/proposal-229c.stderr
new file mode 100644
index 0000000000..965801a3c3
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/proposal-229c.stderr
@@ -0,0 +1,4 @@
+
+proposal-229c.hs:6:3: error:
+ Illegal bang-pattern (use BangPatterns):
+ !x
diff --git a/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
index c02d2ee974..27e6c709a5 100644
--- a/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
+++ b/testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
@@ -1,3 +1,3 @@
strictnessDataCon_A.hs:1:27: error:
- Strictness annotation cannot appear in this position.
+ Operator applied to too few arguments: !
diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
index 88fc8d50b9..ad78bc9729 100644
--- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
@@ -1,23 +1,23 @@
[1 of 2] Compiling Splices ( Splices.hs, Splices.o )
[2 of 2] Compiling SplicesUsed ( SplicesUsed.hs, SplicesUsed.o )
-SplicesUsed.hs:7:16: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:7:15: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Maybe Bool’
• In the type ‘_’
In the type signature: maybeBool :: (_)
-SplicesUsed.hs:8:15: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:8:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_a’ standing for ‘_’
Where: ‘_’ is a rigid type variable bound by
the inferred type of <expression> :: _ -> _
- at SplicesUsed.hs:8:15-22
+ at SplicesUsed.hs:8:14-23
• In an expression type signature: _a -> _a
In the expression: id :: _a -> _a
In the expression: (id :: _a -> _a) (Just True :: Maybe _)
• Relevant bindings include
maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
-SplicesUsed.hs:8:27: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:8:26: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Bool’
• In the first argument of ‘Maybe’, namely ‘_’
In the type ‘Maybe _’
@@ -25,7 +25,7 @@ SplicesUsed.hs:8:27: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Relevant bindings include
maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
-SplicesUsed.hs:10:17: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:10:16: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘(Char, a)’
Where: ‘a’ is a rigid type variable bound by
the inferred type of charA :: a -> (Char, a)
@@ -33,7 +33,7 @@ SplicesUsed.hs:10:17: warning: [-Wpartial-type-signatures (in -Wdefault)]
• In the type ‘a -> (_)’
In the type signature: charA :: a -> (_)
-SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:13:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘a -> Bool’
Where: ‘a’ is a rigid type variable bound by
the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
@@ -41,7 +41,7 @@ SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• In the type ‘_ -> _ -> _’
In the type signature: filter' :: (_ -> _ -> _)
-SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:13:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘[a]’
Where: ‘a’ is a rigid type variable bound by
the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
@@ -49,7 +49,7 @@ SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• In the type ‘_ -> _ -> _’
In the type signature: filter' :: (_ -> _ -> _)
-SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:13:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘[a]’
Where: ‘a’ is a rigid type variable bound by
the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
@@ -57,27 +57,27 @@ SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• In the type ‘_ -> _ -> _’
In the type signature: filter' :: (_ -> _ -> _)
-SplicesUsed.hs:16:3: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:16:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Eq a’
Where: ‘a’ is a rigid type variable bound by
the inferred type of foo :: Eq a => a -> a -> Bool
- at SplicesUsed.hs:16:3-10
+ at SplicesUsed.hs:16:2-11
• In the type signature: foo :: _ => _
-SplicesUsed.hs:16:3: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:16:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘a -> a -> Bool’
Where: ‘a’ is a rigid type variable bound by
the inferred type of foo :: Eq a => a -> a -> Bool
- at SplicesUsed.hs:16:3-10
+ at SplicesUsed.hs:16:2-11
• In the type signature: foo :: _ => _
-SplicesUsed.hs:18:3: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:18:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_a’ standing for ‘Bool’
• In the type signature: bar :: _a -> _b -> (_a, _b)
-SplicesUsed.hs:18:3: warning: [-Wpartial-type-signatures (in -Wdefault)]
+SplicesUsed.hs:18:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_b’ standing for ‘_’
Where: ‘_’ is a rigid type variable bound by
the inferred type of bar :: Bool -> _ -> (Bool, _)
- at SplicesUsed.hs:18:3-10
+ at SplicesUsed.hs:18:2-11
• In the type signature: bar :: _a -> _b -> (_a, _b)
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
index 2426e4cd27..2a83a36cc2 100644
--- a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
@@ -1,5 +1,5 @@
-ExtraConstraintsWildcardInPatternSplice.hs:5:8: error:
+ExtraConstraintsWildcardInPatternSplice.hs:5:6: error:
• Found type wildcard ‘_’ standing for ‘_’
Where: ‘_’ is a rigid type variable bound by
the inferred type of foo :: _ -> ()
diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout
index f010ce98f8..33f8ff722d 100644
--- a/testsuite/tests/plugins/plugins10.stdout
+++ b/testsuite/tests/plugins/plugins10.stdout
@@ -13,7 +13,7 @@ interfacePlugin: GHC.Natural
parsePlugin(a)
typeCheckPlugin (rn)
interfacePlugin: Language.Haskell.TH.Lib.Internal
-metaPlugin: return []
+metaPlugin: (return [])
metaPlugin: quoteExp stringify "x"
interfacePlugin: GHC.CString
typeCheckPlugin (rn)
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index fce8b7d136..0d7e44b4b6 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -52,6 +52,7 @@ typecheckPlugin [name, "typecheck"] _ tc
typecheckPlugin _ _ tc = return tc
metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
+metaPlugin' opts (L l (HsPar x e)) = (\e' -> L l (HsPar x e')) <$> metaPlugin' opts e
metaPlugin' [name, "meta"] (L _ (HsApp noExt (L l (HsVar _ (L _ id))) e))
| occNameString (getOccName id) == name
= return e
diff --git a/testsuite/tests/printer/T13199.stdout b/testsuite/tests/printer/T13199.stdout
index 62e56590e0..6ccc1f10f0 100644
--- a/testsuite/tests/printer/T13199.stdout
+++ b/testsuite/tests/printer/T13199.stdout
@@ -1,48 +1,48 @@
-T13199.hs:(14,3)-(15,6): Splicing declarations
+T13199.hs:(14,2)-(15,7): Splicing declarations
[d| instance C (Maybe a) (Maybe b) c |]
======>
instance C (Maybe a) (Maybe b) c
-T13199.hs:21:3-44: Splicing declarations
+T13199.hs:21:2-45: Splicing declarations
[d| g (a :: (Int -> Int) -> Int) = True |]
======>
g (a :: (Int -> Int) -> Int) = True
-T13199.hs:24:3-27: Splicing declarations
+T13199.hs:24:2-28: Splicing declarations
[d| h (id -> x) = True |] ======> h (id -> x) = True
-T13199.hs:27:3-37: Splicing declarations
+T13199.hs:27:2-38: Splicing declarations
[d| f (Just (Just False)) = True |]
======>
f (Just (Just False)) = True
-T13199.hs:30:3-33: Splicing declarations
+T13199.hs:30:2-34: Splicing declarations
[d| i (B (a `B` c) d) = True |] ======> i (B (a `B` c) d) = True
-T13199.hs:33:3-29: Splicing declarations
+T13199.hs:33:2-30: Splicing declarations
[d| j B {aa = a} = True |] ======> j B {aa = a} = True
-T13199.hs:36:3-28: Splicing declarations
+T13199.hs:36:2-29: Splicing declarations
[d| k = id @(Maybe Int) |] ======> k = id @(Maybe Int)
-T13199.hs:38:3-58: Splicing declarations
+T13199.hs:38:2-59: Splicing declarations
[d| l = case Just 'a' of { Just a -> Just ((\ x -> x) a) } |]
======>
l = case Just 'a' of { Just a -> Just ((\ x -> x) a) }
-T13199.ppr.hs:11:3-41: Splicing declarations
+T13199.ppr.hs:11:2-42: Splicing declarations
[d| instance C (Maybe a) (Maybe b) c |]
======>
instance C (Maybe a) (Maybe b) c
-T13199.ppr.hs:12:3-44: Splicing declarations
+T13199.ppr.hs:12:2-45: Splicing declarations
[d| g (a :: (Int -> Int) -> Int) = True |]
======>
g (a :: (Int -> Int) -> Int) = True
-T13199.ppr.hs:13:3-27: Splicing declarations
+T13199.ppr.hs:13:2-28: Splicing declarations
[d| h (id -> x) = True |] ======> h (id -> x) = True
-T13199.ppr.hs:14:3-37: Splicing declarations
+T13199.ppr.hs:14:2-38: Splicing declarations
[d| f (Just (Just False)) = True |]
======>
f (Just (Just False)) = True
-T13199.ppr.hs:15:3-33: Splicing declarations
+T13199.ppr.hs:15:2-34: Splicing declarations
[d| i (B (a `B` c) d) = True |] ======> i (B (a `B` c) d) = True
-T13199.ppr.hs:16:3-28: Splicing declarations
+T13199.ppr.hs:16:2-29: Splicing declarations
[d| j B {aa = a} = True |] ======> j B {aa = a} = True
-T13199.ppr.hs:17:3-28: Splicing declarations
+T13199.ppr.hs:17:2-29: Splicing declarations
[d| k = id @(Maybe Int) |] ======> k = id @(Maybe Int)
-T13199.ppr.hs:18:3-63: Splicing declarations
+T13199.ppr.hs:18:2-64: Splicing declarations
[d| l = case Just 'a' of { Just a -> Just ((\ x -> x) a) } |]
======>
l = case Just 'a' of { Just a -> Just ((\ x -> x) a) }
diff --git a/testsuite/tests/printer/T13550.stdout b/testsuite/tests/printer/T13550.stdout
index ff02835912..7f74e48895 100644
--- a/testsuite/tests/printer/T13550.stdout
+++ b/testsuite/tests/printer/T13550.stdout
@@ -1,4 +1,4 @@
-T13550.hs:(6,3)-(11,6): Splicing declarations
+T13550.hs:(6,2)-(11,7): Splicing declarations
[d| type family Foo a b
data family Bar a b
@@ -9,7 +9,7 @@ T13550.hs:(6,3)-(11,6): Splicing declarations
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data family Bar a b
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)
-T13550.ppr.hs:(5,3)-(8,69): Splicing declarations
+T13550.ppr.hs:(5,2)-(8,70): Splicing declarations
[d| type family Foo a b
data family Bar a b
diff --git a/testsuite/tests/printer/T13942.stdout b/testsuite/tests/printer/T13942.stdout
index 2d0f617074..f40a71bf0f 100644
--- a/testsuite/tests/printer/T13942.stdout
+++ b/testsuite/tests/printer/T13942.stdout
@@ -1,10 +1,10 @@
-T13942.hs:(5,3)-(7,6): Splicing declarations
+T13942.hs:(5,2)-(7,7): Splicing declarations
[d| f :: Either Int (Int -> Int)
f = undefined |]
======>
f :: Either Int (Int -> Int)
f = undefined
-T13942.ppr.hs:(4,3)-(5,22): Splicing declarations
+T13942.ppr.hs:(4,2)-(5,23): Splicing declarations
[d| f :: Either Int (Int -> Int)
f = undefined |]
======>
diff --git a/testsuite/tests/printer/T14289.stdout b/testsuite/tests/printer/T14289.stdout
index 3f0754adca..b11a3bf063 100644
--- a/testsuite/tests/printer/T14289.stdout
+++ b/testsuite/tests/printer/T14289.stdout
@@ -1,4 +1,4 @@
-T14289.hs:10:3-42: Splicing declarations
+T14289.hs:10:2-43: Splicing declarations
[d| data Foo a
= Foo a
deriving (C a) |]
@@ -6,7 +6,7 @@ T14289.hs:10:3-42: Splicing declarations
data Foo a
= Foo a
deriving (C a)
-T14289.ppr.hs:(7,3)-(9,25): Splicing declarations
+T14289.ppr.hs:(7,2)-(9,26): Splicing declarations
[d| data Foo a
= Foo a
deriving (C a) |]
diff --git a/testsuite/tests/printer/T14289b.stdout b/testsuite/tests/printer/T14289b.stdout
index 5d4b248ac3..5c6e0f7474 100644
--- a/testsuite/tests/printer/T14289b.stdout
+++ b/testsuite/tests/printer/T14289b.stdout
@@ -1,4 +1,4 @@
-T14289b.hs:11:3-46: Splicing declarations
+T14289b.hs:11:2-47: Splicing declarations
[d| data Foo a
= Foo a
deriving (y `C` z) |]
@@ -6,7 +6,7 @@ T14289b.hs:11:3-46: Splicing declarations
data Foo a
= Foo a
deriving (C y z)
-T14289b.ppr.hs:(8,3)-(10,29): Splicing declarations
+T14289b.ppr.hs:(8,2)-(10,30): Splicing declarations
[d| data Foo a
= Foo a
deriving (y `C` z) |]
diff --git a/testsuite/tests/printer/T14289c.stdout b/testsuite/tests/printer/T14289c.stdout
index d200f99a2b..287793b6ea 100644
--- a/testsuite/tests/printer/T14289c.stdout
+++ b/testsuite/tests/printer/T14289c.stdout
@@ -1,4 +1,4 @@
-T14289c.hs:9:3-44: Splicing declarations
+T14289c.hs:9:2-45: Splicing declarations
[d| data Foo a
= Foo a
deriving (a ~ a) |]
@@ -6,7 +6,7 @@ T14289c.hs:9:3-44: Splicing declarations
data Foo a
= Foo a
deriving (a ~ a)
-T14289c.ppr.hs:(7,3)-(9,27): Splicing declarations
+T14289c.ppr.hs:(7,2)-(9,28): Splicing declarations
[d| data Foo a
= Foo a
deriving (a ~ a) |]
diff --git a/testsuite/tests/rename/should_fail/T12879.stderr b/testsuite/tests/rename/should_fail/T12879.stderr
index 1b3559c255..0c6b7f36f5 100644
--- a/testsuite/tests/rename/should_fail/T12879.stderr
+++ b/testsuite/tests/rename/should_fail/T12879.stderr
@@ -1,4 +1,4 @@
T12879.hs:4:7: error:
- Pattern syntax in expression context: x@x
+ @-pattern in expression context: x@x
Type application syntax requires a space before '@'
diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr
index 47436132f2..6ed450ce0b 100644
--- a/testsuite/tests/rename/should_fail/rnfail016.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail016.stderr
@@ -1,4 +1,4 @@
rnfail016.hs:6:7: error:
- Pattern syntax in expression context: x@x
- Did you mean to enable TypeApplications?
+ @-pattern in expression context: x@x
+ Type application syntax requires a space before '@'
diff --git a/testsuite/tests/rename/should_fail/rnfail016a.stderr b/testsuite/tests/rename/should_fail/rnfail016a.stderr
index 3a59ee7478..544cf58cac 100644
--- a/testsuite/tests/rename/should_fail/rnfail016a.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail016a.stderr
@@ -1,2 +1,2 @@
-rnfail016a.hs:6:7: error: Pattern syntax in expression context: ~x
+rnfail016a.hs:6:7: error: parse error on input ‘~’
diff --git a/testsuite/tests/rename/should_fail/rnfail051.stderr b/testsuite/tests/rename/should_fail/rnfail051.stderr
index 9c45a6168b..c1f4f43a2f 100644
--- a/testsuite/tests/rename/should_fail/rnfail051.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail051.stderr
@@ -1,3 +1,3 @@
rnfail051.hs:7:17: error:
- Pattern syntax in expression context: _ -> putStrLn "_"
+ View pattern in expression context: _ -> putStrLn "_"
diff --git a/testsuite/tests/roles/should_compile/T16718.stderr b/testsuite/tests/roles/should_compile/T16718.stderr
index 8e2530ef31..18c1bee5d1 100644
--- a/testsuite/tests/roles/should_compile/T16718.stderr
+++ b/testsuite/tests/roles/should_compile/T16718.stderr
@@ -1,4 +1,4 @@
-T16718.hs:(5,3)-(7,6): Splicing declarations
+T16718.hs:(5,2)-(7,7): Splicing declarations
[d| type role P phantom
data P a |]
diff --git a/testsuite/tests/saks/should_compile/T17164.stderr b/testsuite/tests/saks/should_compile/T17164.stderr
index 5b1fdbf0fc..87bcb9b3ff 100644
--- a/testsuite/tests/saks/should_compile/T17164.stderr
+++ b/testsuite/tests/saks/should_compile/T17164.stderr
@@ -1,4 +1,4 @@
-T17164.hs:(12,3)-(14,6): Splicing declarations
+T17164.hs:(12,2)-(14,7): Splicing declarations
[d| type T :: forall k -> k -> Type
type family T :: forall k -> k -> Type |]
diff --git a/testsuite/tests/saks/should_compile/saks027.stderr b/testsuite/tests/saks/should_compile/saks027.stderr
index 730b1cfde6..8a1b5d8057 100644
--- a/testsuite/tests/saks/should_compile/saks027.stderr
+++ b/testsuite/tests/saks/should_compile/saks027.stderr
@@ -1,4 +1,4 @@
-saks027.hs:(8,3)-(10,6): Splicing declarations
+saks027.hs:(8,2)-(10,7): Splicing declarations
[d| type U :: Type
data U = MkU |]
diff --git a/testsuite/tests/th/ClosedFam1TH.stderr b/testsuite/tests/th/ClosedFam1TH.stderr
index 8db375413a..0ffa3428e7 100644
--- a/testsuite/tests/th/ClosedFam1TH.stderr
+++ b/testsuite/tests/th/ClosedFam1TH.stderr
@@ -1,5 +1,5 @@
-ClosedFam1TH.hs:7:3: warning:
+ClosedFam1TH.hs:7:2: warning:
type family Foo_0 a_1 (b_2 :: k_3) where
Foo_0 GHC.Types.Int GHC.Types.Bool = GHC.Types.Int
Foo_0 a_4 GHC.Maybe.Maybe = GHC.Types.Bool
diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr
index d5f7052d05..e71f28795b 100644
--- a/testsuite/tests/th/T10279.stderr
+++ b/testsuite/tests/th/T10279.stderr
@@ -1,5 +1,5 @@
-T10279.hs:10:10: error:
+T10279.hs:10:9: error:
• Failed to load interface for ‘A’
no unit id matching ‘rts-1.0’ was found
(This unit ID looks like the source package ID;
diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr
index 64714211fd..d6c08b0a43 100644
--- a/testsuite/tests/th/T10598_TH.stderr
+++ b/testsuite/tests/th/T10598_TH.stderr
@@ -1,13 +1,10 @@
-T10598_TH.hs:(27,3)-(42,50): Splicing declarations
+T10598_TH.hs:(27,2)-(42,51): Splicing declarations
do fooDataName <- newName "Foo"
mkFooConName <- newName "MkFoo"
let fooType = conT fooDataName
sequence
[newtypeD
- (cxt [])
- fooDataName
- []
- Nothing
+ (cxt []) fooDataName [] Nothing
(normalC
mkFooConName
[bangType
@@ -16,18 +13,15 @@ T10598_TH.hs:(27,3)-(42,50): Splicing declarations
derivClause (Just AnyclassStrategy) [[t| C |]],
derivClause (Just NewtypeStrategy) [[t| Read |]]],
standaloneDerivWithStrategyD
- (Just StockStrategy)
- (cxt [])
+ (Just StockStrategy) (cxt [])
[t| Ord $(fooType) |]
pending(rn) [<splice, fooType>],
standaloneDerivWithStrategyD
- (Just AnyclassStrategy)
- (cxt [])
+ (Just AnyclassStrategy) (cxt [])
[t| D $(fooType) |]
pending(rn) [<splice, fooType>],
standaloneDerivWithStrategyD
- (Just NewtypeStrategy)
- (cxt [])
+ (Just NewtypeStrategy) (cxt [])
[t| Show $(fooType) |]
pending(rn) [<splice, fooType>]]
======>
diff --git a/testsuite/tests/th/T10603.stderr b/testsuite/tests/th/T10603.stderr
index c294e74226..3de6cb057b 100644
--- a/testsuite/tests/th/T10603.stderr
+++ b/testsuite/tests/th/T10603.stderr
@@ -1,4 +1,4 @@
-T10603.hs:5:18-68: Splicing expression
+T10603.hs:5:17-69: Splicing expression
[| case Just 'a' of { Just a -> Just ((\ x -> x) a) } |]
======>
case Just 'a' of { Just a -> Just ((\ x -> x) a) }
diff --git a/testsuite/tests/th/T10638.stderr b/testsuite/tests/th/T10638.stderr
index cc4946a074..582190e688 100644
--- a/testsuite/tests/th/T10638.stderr
+++ b/testsuite/tests/th/T10638.stderr
@@ -1,5 +1,5 @@
-T10638.hs:26:11:
- ‘static test2’ is not a valid C identifier
- When checking declaration:
- foreign import prim safe "static test2" cmm_test2 :: Int# -> Int#
+T10638.hs:26:10: error:
+ • ‘static test2’ is not a valid C identifier
+ • When checking declaration:
+ foreign import prim safe "static test2" cmm_test2 :: Int# -> Int#
diff --git a/testsuite/tests/th/T10796b.stderr b/testsuite/tests/th/T10796b.stderr
index 2491a8c259..7c7b89171b 100644
--- a/testsuite/tests/th/T10796b.stderr
+++ b/testsuite/tests/th/T10796b.stderr
@@ -1,5 +1,5 @@
-T10796b.hs:8:17: error:
+T10796b.hs:8:16: error:
• Can't construct a pattern from name Data.Set.Internal.fromList
• In the untyped splice:
$(dataToPatQ (const Nothing) (fromList "test"))
diff --git a/testsuite/tests/th/T10810.stderr b/testsuite/tests/th/T10810.stderr
index c960fe1941..83e9434cb1 100644
--- a/testsuite/tests/th/T10810.stderr
+++ b/testsuite/tests/th/T10810.stderr
@@ -1,2 +1,2 @@
-T10810.hs:6:3-24: Splicing declarations
+T10810.hs:6:2-25: Splicing declarations
[d| data Foo = (:!) |] ======> data Foo = (:!)
diff --git a/testsuite/tests/th/T10828a.stderr b/testsuite/tests/th/T10828a.stderr
index 9c05b83190..6f2b16465a 100644
--- a/testsuite/tests/th/T10828a.stderr
+++ b/testsuite/tests/th/T10828a.stderr
@@ -1,4 +1,4 @@
-T10828a.hs:9:4:
+T10828a.hs:9:2: error:
Kind signatures are only allowed on GADTs
When splicing a TH declaration: data T a :: * = MkT a a
diff --git a/testsuite/tests/th/T10828b.stderr b/testsuite/tests/th/T10828b.stderr
index bbc57dd3ab..e5f36906f7 100644
--- a/testsuite/tests/th/T10828b.stderr
+++ b/testsuite/tests/th/T10828b.stderr
@@ -1,5 +1,5 @@
-T10828b.hs:9:4:
+T10828b.hs:9:2: error:
Cannot mix GADT constructors with Haskell 98 constructors
When splicing a TH declaration:
data T a :: *
diff --git a/testsuite/tests/th/T11452.stderr b/testsuite/tests/th/T11452.stderr
index e4f1cc604d..0649997ff1 100644
--- a/testsuite/tests/th/T11452.stderr
+++ b/testsuite/tests/th/T11452.stderr
@@ -1,5 +1,5 @@
-T11452.hs:6:14: error:
+T11452.hs:6:12: error:
• Illegal polytype: (forall a. a -> a) -> ()
The type of a Typed Template Haskell expression must not have any quantification.
• In the Template Haskell splice $$([|| \ _ -> () ||])
diff --git a/testsuite/tests/th/T12045TH1.stderr b/testsuite/tests/th/T12045TH1.stderr
index aede24c7a0..2b856434d5 100644
--- a/testsuite/tests/th/T12045TH1.stderr
+++ b/testsuite/tests/th/T12045TH1.stderr
@@ -1,4 +1,4 @@
-T12045TH1.hs:(8,3)-(10,52): Splicing declarations
+T12045TH1.hs:(8,2)-(10,53): Splicing declarations
[d| type family F (a :: k) :: Type where
F @Type Int = Bool
F @(Type -> Type) Maybe = Char |]
@@ -6,13 +6,13 @@ T12045TH1.hs:(8,3)-(10,52): Splicing declarations
type family F (a :: k) :: Type where
F @Type Int = Bool
F @(Type -> Type) Maybe = Char
-T12045TH1.hs:13:3-31: Splicing declarations
+T12045TH1.hs:13:2-32: Splicing declarations
[d| data family D (a :: k) |] ======> data family D (a :: k)
-T12045TH1.hs:15:3-40: Splicing declarations
+T12045TH1.hs:15:2-41: Splicing declarations
[d| data instance D @Type a = DBool |]
======>
data instance D @Type a = DBool
-T12045TH1.hs:17:3-50: Splicing declarations
+T12045TH1.hs:17:2-51: Splicing declarations
[d| data instance D @(Type -> Type) b = DChar |]
======>
data instance D @(Type -> Type) b = DChar
diff --git a/testsuite/tests/th/T12387.stderr b/testsuite/tests/th/T12387.stderr
index 81c2eef5f7..53b8550cdd 100644
--- a/testsuite/tests/th/T12387.stderr
+++ b/testsuite/tests/th/T12387.stderr
@@ -1,4 +1,4 @@
-T12387.hs:8:3: error:
+T12387.hs:8:2: error:
• Class ‘Eq’ does not have a method ‘compare’
• In the instance declaration for ‘Eq Foo’
diff --git a/testsuite/tests/th/T12411.stderr b/testsuite/tests/th/T12411.stderr
index 1f344323bd..65f77d0723 100644
--- a/testsuite/tests/th/T12411.stderr
+++ b/testsuite/tests/th/T12411.stderr
@@ -1,4 +1,8 @@
-T12411.hs:4:1: error:
- Pattern syntax in expression context: pure@Q
- Did you mean to enable TypeApplications?
+T12411.hs:4:6: error:
+ Variable not in scope:
+ (@)
+ :: (a0 -> f0 a0) -> t0 -> Language.Haskell.TH.Lib.Internal.DecsQ
+
+T12411.hs:4:7: error:
+ Data constructor not in scope: Q :: [a1] -> t0
diff --git a/testsuite/tests/th/T12478_4.stderr b/testsuite/tests/th/T12478_4.stderr
index 6a68b3d15a..2cc0d1142d 100644
--- a/testsuite/tests/th/T12478_4.stderr
+++ b/testsuite/tests/th/T12478_4.stderr
@@ -1,5 +1,5 @@
-T12478_4.hs:7:8: error:
+T12478_4.hs:7:7: error:
• Illegal sum arity: 1
Sums must have an arity of at least 2
When splicing a TH type: (# #) GHC.Tuple.()
diff --git a/testsuite/tests/th/T12530.stderr b/testsuite/tests/th/T12530.stderr
index 0ba15360ac..7398b32df1 100644
--- a/testsuite/tests/th/T12530.stderr
+++ b/testsuite/tests/th/T12530.stderr
@@ -1,4 +1,4 @@
-T12530.hs:(8,3)-(15,6): Splicing declarations
+T12530.hs:(8,2)-(15,7): Splicing declarations
[d| f :: Maybe Int -> Maybe Int
f = id @(Maybe Int)
g :: forall a. a
diff --git a/testsuite/tests/th/T13776.stderr b/testsuite/tests/th/T13776.stderr
index 485dc64a28..debcc0bbcd 100644
--- a/testsuite/tests/th/T13776.stderr
+++ b/testsuite/tests/th/T13776.stderr
@@ -1,14 +1,12 @@
-T13776.hs:10:16-42: Splicing type
+T13776.hs:10:15-43: Splicing type
conT ''[] `appT` conT ''Int ======> [] Int
-T13776.hs:7:16-61: Splicing type
+T13776.hs:7:15-62: Splicing type
conT ''(,) `appT` conT ''Int `appT` conT ''Int ======> (,) Int Int
-T13776.hs:14:16-74: Splicing expression
+T13776.hs:14:15-75: Splicing expression
conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)
======>
((,) 1) 1
-T13776.hs:17:16-23: Splicing expression
- conE '[] ======> []
-T13776.hs:20:14-61: Splicing pattern
+T13776.hs:17:15-24: Splicing expression conE '[] ======> []
+T13776.hs:20:13-62: Splicing pattern
conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1
-T13776.hs:23:14-24: Splicing pattern
- conP '[] [] ======> []
+T13776.hs:23:13-25: Splicing pattern conP '[] [] ======> []
diff --git a/testsuite/tests/th/T13837.stderr b/testsuite/tests/th/T13837.stderr
index 53700b5a7a..7bb6587ded 100644
--- a/testsuite/tests/th/T13837.stderr
+++ b/testsuite/tests/th/T13837.stderr
@@ -1,5 +1,5 @@
-T13837.hs:9:5: error:
+T13837.hs:9:4: error:
• The exact Name ‘Fam’ is not in scope
Probable cause: you used a unique Template Haskell name (NameU),
perhaps via newName, but did not bind it
diff --git a/testsuite/tests/th/T13856.stderr b/testsuite/tests/th/T13856.stderr
index 141b7a2f69..1d54574253 100644
--- a/testsuite/tests/th/T13856.stderr
+++ b/testsuite/tests/th/T13856.stderr
@@ -1 +1 @@
-T13856.hs:8:7-22: Splicing expression lamE [] [| 42 |] ======> 42
+T13856.hs:8:6-23: Splicing expression lamE [] [| 42 |] ======> 42
diff --git a/testsuite/tests/th/T13968.stderr b/testsuite/tests/th/T13968.stderr
index 2850dae0c5..420e3c6432 100644
--- a/testsuite/tests/th/T13968.stderr
+++ b/testsuite/tests/th/T13968.stderr
@@ -1,3 +1,3 @@
-T13968.hs:6:3: error:
+T13968.hs:6:2: error:
Cannot redefine a Name retrieved by a Template Haskell quote: succ
diff --git a/testsuite/tests/th/T14204.stderr b/testsuite/tests/th/T14204.stderr
index 90150e2050..5a8f57aa58 100644
--- a/testsuite/tests/th/T14204.stderr
+++ b/testsuite/tests/th/T14204.stderr
@@ -1,5 +1,5 @@
-T14204.hs:8:35: error:
+T14204.hs:8:34: error:
• Illegal static expression: static "wat"
Use StaticPointers to enable this extension
• In the untyped splice: $(pure (StaticE (LitE (StringL "wat"))))
diff --git a/testsuite/tests/th/T14646.stderr b/testsuite/tests/th/T14646.stderr
index 869cf6fd01..a8a82b1426 100644
--- a/testsuite/tests/th/T14646.stderr
+++ b/testsuite/tests/th/T14646.stderr
@@ -1,4 +1,4 @@
-T14646.hs:(5,3)-(6,24): Splicing declarations
+T14646.hs:(5,2)-(6,25): Splicing declarations
[d| f :: (forall a. a) -> Int
f _ = undefined |]
======>
diff --git a/testsuite/tests/th/T14681.stderr b/testsuite/tests/th/T14681.stderr
index debb18dee5..0a23fd1473 100644
--- a/testsuite/tests/th/T14681.stderr
+++ b/testsuite/tests/th/T14681.stderr
@@ -1,6 +1,6 @@
-T14681.hs:7:3-31: Splicing declarations
+T14681.hs:7:2-32: Splicing declarations
[d| f = \ (Identity x) -> x |] ======> f = \ (Identity x) -> x
-T14681.hs:(8,3)-(9,62): Splicing declarations
+T14681.hs:(8,2)-(9,63): Splicing declarations
[d| g = $(pure
$ VarE '(+) `AppE` LitE (IntegerL (- 1))
`AppE` (LitE (IntegerL (- 1)))) |]
diff --git a/testsuite/tests/th/T14817.stderr b/testsuite/tests/th/T14817.stderr
index 034c9e3bed..524711c988 100644
--- a/testsuite/tests/th/T14817.stderr
+++ b/testsuite/tests/th/T14817.stderr
@@ -1,4 +1,4 @@
-T14817.hs:(7,3)-(8,34): Splicing declarations
+T14817.hs:(7,2)-(8,35): Splicing declarations
[d| data family Foo :: Type
data instance Foo :: Type |]
diff --git a/testsuite/tests/th/T14869.stderr b/testsuite/tests/th/T14869.stderr
index a2776b8cc8..5361f697e3 100644
--- a/testsuite/tests/th/T14869.stderr
+++ b/testsuite/tests/th/T14869.stderr
@@ -1,17 +1,17 @@
-T14869.hs:19:3-9: Splicing declarations pure [] ======>
-T14869.hs:22:10-42: Splicing expression
+T14869.hs:19:2-10: Splicing declarations pure [] ======>
+T14869.hs:22:9-43: Splicing expression
reify ''Foo1 >>= stringE . pprint
======>
"type family T14869.Foo1 :: *"
-T14869.hs:23:10-42: Splicing expression
+T14869.hs:23:9-43: Splicing expression
reify ''Foo2 >>= stringE . pprint
======>
"type family T14869.Foo2 :: Constraint"
-T14869.hs:24:10-42: Splicing expression
+T14869.hs:24:9-43: Splicing expression
reify ''Foo3 >>= stringE . pprint
======>
"type family T14869.Foo3 :: T14869.MyConstraint"
-T14869.hs:25:10-42: Splicing expression
+T14869.hs:25:9-43: Splicing expression
reify ''Foo4 >>= stringE . pprint
======>
"type family T14869.Foo4 :: *"
diff --git a/testsuite/tests/th/T14875.stderr b/testsuite/tests/th/T14875.stderr
index 09374f243d..e5e54b9558 100644
--- a/testsuite/tests/th/T14875.stderr
+++ b/testsuite/tests/th/T14875.stderr
@@ -1,4 +1,4 @@
-T14875.hs:(5,3)-(14,6): Splicing declarations
+T14875.hs:(5,2)-(14,7): Splicing declarations
[d| f :: Bool -> Bool
f x
= case x of
diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr
index e6d63254e7..4df1e669dc 100644
--- a/testsuite/tests/th/T14888.stderr
+++ b/testsuite/tests/th/T14888.stderr
@@ -1,7 +1,7 @@
-T14888.hs:6:10-30: Splicing type
+T14888.hs:6:9-31: Splicing type
[t| (->) Bool Bool |] ======> Bool -> Bool
-T14888.hs:15:3-11: Splicing declarations return [] ======>
-T14888.hs:18:23-59: Splicing expression
+T14888.hs:15:2-12: Splicing declarations return [] ======>
+T14888.hs:18:22-60: Splicing expression
reify ''Functor' >>= stringE . pprint
======>
"class T14888.Functor' (f_0 :: * -> *)
diff --git a/testsuite/tests/th/T15243.stderr b/testsuite/tests/th/T15243.stderr
index 4e50186c1f..4cf78cacd6 100644
--- a/testsuite/tests/th/T15243.stderr
+++ b/testsuite/tests/th/T15243.stderr
@@ -1,12 +1,12 @@
-T15243.hs:(10,3)-(15,6): Splicing declarations
+T15243.hs:(10,2)-(15,7): Splicing declarations
[d| type family F (a :: k) :: k where
- F 'Unit = 'Unit
- F '(,) = '(,)
+ F 'Unit = 'Unit
+ F '(,) = '(,)
F '[] = '[]
- F '(:) = '(:) |]
+ F '(:) = '(:) |]
======>
type family F (a :: k) :: k where
- F 'Unit = 'Unit
- F '(,) = '(,)
+ F 'Unit = 'Unit
+ F '(,) = '(,)
F '[] = '[]
- F '(:) = '(:)
+ F '(:) = '(:)
diff --git a/testsuite/tests/th/T15270A.stderr b/testsuite/tests/th/T15270A.stderr
index 2eb67f60ba..ba43e4dae8 100644
--- a/testsuite/tests/th/T15270A.stderr
+++ b/testsuite/tests/th/T15270A.stderr
@@ -1,5 +1,5 @@
-T15270A.hs:8:7:
- Illegal data constructor name: ‘id’
+T15270A.hs:8:6: error:
+ • Illegal data constructor name: ‘id’
When splicing a TH expression: GHC.Base.id
- In the untyped splice: $(conE 'id)
+ • In the untyped splice: $(conE 'id)
diff --git a/testsuite/tests/th/T15270B.stderr b/testsuite/tests/th/T15270B.stderr
index 3403d13e2b..8db1dc4b6d 100644
--- a/testsuite/tests/th/T15270B.stderr
+++ b/testsuite/tests/th/T15270B.stderr
@@ -1,5 +1,5 @@
-T15270B.hs:8:7:
- Illegal variable name: ‘Just’
+T15270B.hs:8:6: error:
+ • Illegal variable name: ‘Just’
When splicing a TH expression: GHC.Maybe.Just
- In the untyped splice: $(varE 'Just)
+ • In the untyped splice: $(varE 'Just)
diff --git a/testsuite/tests/th/T15324.stderr b/testsuite/tests/th/T15324.stderr
index 49db9ed8d9..0879fff9d3 100644
--- a/testsuite/tests/th/T15324.stderr
+++ b/testsuite/tests/th/T15324.stderr
@@ -1,4 +1,4 @@
-T15324.hs:(5,3)-(7,6): Splicing declarations
+T15324.hs:(5,2)-(7,7): Splicing declarations
[d| f :: forall a. (Show a => a) -> a
f _ = undefined |]
======>
diff --git a/testsuite/tests/th/T15331.stderr b/testsuite/tests/th/T15331.stderr
index 99bfdfd198..dee7e8c8d0 100644
--- a/testsuite/tests/th/T15331.stderr
+++ b/testsuite/tests/th/T15331.stderr
@@ -1,4 +1,4 @@
-T15331.hs:(7,3)-(9,6): Splicing declarations
+T15331.hs:(7,2)-(9,7): Splicing declarations
[d| f :: Proxy (Int -> Int)
f = Proxy @(Int -> Int) |]
======>
diff --git a/testsuite/tests/th/T15360b.stderr b/testsuite/tests/th/T15360b.stderr
index aa3f6d93de..7bfacf202e 100644
--- a/testsuite/tests/th/T15360b.stderr
+++ b/testsuite/tests/th/T15360b.stderr
@@ -1,20 +1,20 @@
-T15360b.hs:10:14: error:
+T15360b.hs:10:13: error:
• Expected kind ‘* -> k3’, but ‘Type’ has kind ‘*’
• In the first argument of ‘Proxy’, namely ‘(Type Double)’
In the type signature: x :: Proxy (Type Double)
-T15360b.hs:13:14: error:
+T15360b.hs:13:13: error:
• Expected kind ‘* -> k2’, but ‘1’ has kind ‘GHC.Types.Nat’
• In the first argument of ‘Proxy’, namely ‘(1 Int)’
In the type signature: y :: Proxy (1 Int)
-T15360b.hs:16:14: error:
+T15360b.hs:16:13: error:
• Expected kind ‘* -> k1’, but ‘Constraint’ has kind ‘*’
• In the first argument of ‘Proxy’, namely ‘(Constraint Bool)’
In the type signature: z :: Proxy (Constraint Bool)
-T15360b.hs:19:14: error:
+T15360b.hs:19:13: error:
• Expected kind ‘* -> k0’, but ‘'[]’ has kind ‘[a0]’
• In the first argument of ‘Proxy’, namely ‘('[] Int)’
In the type signature: w :: Proxy ('[] Int)
diff --git a/testsuite/tests/th/T15365.stderr b/testsuite/tests/th/T15365.stderr
index 9631319eab..42f9806945 100644
--- a/testsuite/tests/th/T15365.stderr
+++ b/testsuite/tests/th/T15365.stderr
@@ -1,4 +1,4 @@
-T15365.hs:(9,3)-(31,6): Splicing declarations
+T15365.hs:(9,2)-(31,7): Splicing declarations
[d| (&&&) :: Bool -> Bool -> Bool
(&&&) = (&&)
pattern (:!!!) :: Bool
diff --git a/testsuite/tests/th/T15481.stderr b/testsuite/tests/th/T15481.stderr
index 69a8c7b0e7..01e508f498 100644
--- a/testsuite/tests/th/T15481.stderr
+++ b/testsuite/tests/th/T15481.stderr
@@ -1,4 +1,4 @@
-T15481.hs:(7,19)-(10,63): Splicing expression
+T15481.hs:(7,18)-(10,64): Splicing expression
recover
(stringE "reifyFixity failed")
(do foo <- newName "foo"
diff --git a/testsuite/tests/th/T15502.stderr-ws-32 b/testsuite/tests/th/T15502.stderr-ws-32
index ba7b91c4a5..c7ccfd04a5 100644
--- a/testsuite/tests/th/T15502.stderr-ws-32
+++ b/testsuite/tests/th/T15502.stderr-ws-32
@@ -1,4 +1,4 @@
-T15502.hs:7:19-56: Splicing expression
+T15502.hs:7:17-58: Splicing expression
lift (toInteger (maxBound :: Int) + 1) ======> 2147483648
-T15502.hs:8:19-40: Splicing expression
+T15502.hs:8:17-42: Splicing expression
lift (minBound :: Int) ======> (-2147483648)
diff --git a/testsuite/tests/th/T15502.stderr-ws-64 b/testsuite/tests/th/T15502.stderr-ws-64
index 1177799775..ba61ba3d1b 100644
--- a/testsuite/tests/th/T15502.stderr-ws-64
+++ b/testsuite/tests/th/T15502.stderr-ws-64
@@ -1,4 +1,4 @@
-T15502.hs:7:19-56: Splicing expression
+T15502.hs:7:17-58: Splicing expression
lift (toInteger (maxBound :: Int) + 1) ======> 9223372036854775808
-T15502.hs:8:19-40: Splicing expression
+T15502.hs:8:17-42: Splicing expression
lift (minBound :: Int) ======> (-9223372036854775808)
diff --git a/testsuite/tests/th/T15518.stderr b/testsuite/tests/th/T15518.stderr
index 7d9ef293b4..2eee5ccb8e 100644
--- a/testsuite/tests/th/T15518.stderr
+++ b/testsuite/tests/th/T15518.stderr
@@ -1,4 +1,4 @@
-T15518.hs:(5,3)-(8,6): Splicing declarations
+T15518.hs:(5,2)-(8,7): Splicing declarations
[d| f :: Bool -> ()
f = \case
True -> ()
diff --git a/testsuite/tests/th/T15550.stderr b/testsuite/tests/th/T15550.stderr
index 8169d75613..4c64d4a358 100644
--- a/testsuite/tests/th/T15550.stderr
+++ b/testsuite/tests/th/T15550.stderr
@@ -1,4 +1,4 @@
-T15550.hs:(4,3)-(8,6): Splicing declarations
+T15550.hs:(4,2)-(8,7): Splicing declarations
[d| {-# RULES "myId" forall x. myId x = x #-}
myId :: a -> a
diff --git a/testsuite/tests/th/T15572.stderr b/testsuite/tests/th/T15572.stderr
index 27132d69e0..ad077d887a 100644
--- a/testsuite/tests/th/T15572.stderr
+++ b/testsuite/tests/th/T15572.stderr
@@ -1,6 +1,6 @@
-T15572.hs:7:3-33: Splicing declarations
- [d| type AbsoluteUnit1 = '() |] ======> type AbsoluteUnit1 = '()
-T15572.hs:8:3-54: Splicing declarations
+T15572.hs:7:2-34: Splicing declarations
+ [d| type AbsoluteUnit1 = '() |] ======> type AbsoluteUnit1 = '()
+T15572.hs:8:2-55: Splicing declarations
pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())]
======>
- type AbsoluteUnit2 = '()
+ type AbsoluteUnit2 = '()
diff --git a/testsuite/tests/th/T15738.stderr b/testsuite/tests/th/T15738.stderr
index 57a2db5832..580a02a62e 100644
--- a/testsuite/tests/th/T15738.stderr
+++ b/testsuite/tests/th/T15738.stderr
@@ -1,7 +1,7 @@
f_0 :: (forall a_1 . GHC.Classes.Eq (T15738.Foo a_1)) =>
T15738.Foo x_2 -> T15738.Foo x_2 -> GHC.Types.Bool
f_0 = (GHC.Classes.==)
-T15738.hs:(10,3)-(13,11): Splicing declarations
+T15738.hs:(10,2)-(13,12): Splicing declarations
do d <- [d| f :: (forall a. Eq (Foo a)) => Foo x -> Foo x -> Bool
f = (==) |]
runIO $ hPutStrLn stderr $ pprint d
diff --git a/testsuite/tests/th/T16133.stderr b/testsuite/tests/th/T16133.stderr
index 30dcd3ada0..3901f4d491 100644
--- a/testsuite/tests/th/T16133.stderr
+++ b/testsuite/tests/th/T16133.stderr
@@ -1,8 +1,8 @@
-T16133.hs:10:3: error:
+T16133.hs:10:2: error:
Illegal visible kind application ‘@Type’
Perhaps you intended to use TypeApplications
-T16133.hs:10:3: error:
+T16133.hs:10:2: error:
Illegal visible type application ‘@Int’
Perhaps you intended to use TypeApplications
diff --git a/testsuite/tests/th/T16183.stderr b/testsuite/tests/th/T16183.stderr
index 812fd58ac9..c6951641b3 100644
--- a/testsuite/tests/th/T16183.stderr
+++ b/testsuite/tests/th/T16183.stderr
@@ -1,4 +1,4 @@
-T16183.hs:(7,3)-(11,40): Splicing declarations
+T16183.hs:(7,2)-(11,41): Splicing declarations
[d| type F1 = (Maybe :: Type -> Type) Int
type F2 = (Int :: Type) -> (Int :: Type)
type family F3 a where
diff --git a/testsuite/tests/th/T16326_TH.stderr b/testsuite/tests/th/T16326_TH.stderr
index 8a41fd116d..bf9c20be73 100644
--- a/testsuite/tests/th/T16326_TH.stderr
+++ b/testsuite/tests/th/T16326_TH.stderr
@@ -8,7 +8,7 @@ data Nested_0 :: forall a_1 .
Data.Proxy.Proxy ('(:) a_1
('(:) b_2 ('(:) c_3 ('(:) d_4 ('(:) e_5 '[]))))) ->
*
-T16326_TH.hs:(17,3)-(24,13): Splicing declarations
+T16326_TH.hs:(17,2)-(24,14): Splicing declarations
do info <- reify ''Foo2
liftIO $ hPutStrLn stderr $ pprint info
dec <- [d| data Nested :: forall a.
diff --git a/testsuite/tests/th/T16666.stderr b/testsuite/tests/th/T16666.stderr
index 8264967396..fcacf77076 100644
--- a/testsuite/tests/th/T16666.stderr
+++ b/testsuite/tests/th/T16666.stderr
@@ -1,4 +1,4 @@
-T16666.hs:(9,3)-(11,6): Splicing declarations
+T16666.hs:(9,2)-(11,7): Splicing declarations
[d| class (c => d) => Implies c d
instance (c => d) => Implies c d |]
diff --git a/testsuite/tests/th/T16895a.stderr b/testsuite/tests/th/T16895a.stderr
index d4b98c944a..5a5222eb50 100644
--- a/testsuite/tests/th/T16895a.stderr
+++ b/testsuite/tests/th/T16895a.stderr
@@ -1,5 +1,5 @@
-T16895a.hs:7:16: error:
+T16895a.hs:7:15: error:
• Non-variable expression is not allowed in an infix expression
When splicing a TH expression: 1 `GHC.Base.id GHC.Base.id` 2
• In the untyped splice: $(uInfixE [| 1 |] [| id id |] [| 2 |])
diff --git a/testsuite/tests/th/T16895b.stderr b/testsuite/tests/th/T16895b.stderr
index 8309912f64..597736cad4 100644
--- a/testsuite/tests/th/T16895b.stderr
+++ b/testsuite/tests/th/T16895b.stderr
@@ -1,6 +1,6 @@
-T16895b.hs:7:16:
- Non-variable expression is not allowed in an infix expression
+T16895b.hs:7:15: error:
+ • Non-variable expression is not allowed in an infix expression
When splicing a TH expression: (`GHC.Base.id GHC.Base.id` 2)
- In the untyped splice:
+ • In the untyped splice:
$(infixE Nothing [| id id |] (Just [| 2 |]))
diff --git a/testsuite/tests/th/T16895c.stderr b/testsuite/tests/th/T16895c.stderr
index 38475cce3c..baa5e7526b 100644
--- a/testsuite/tests/th/T16895c.stderr
+++ b/testsuite/tests/th/T16895c.stderr
@@ -1,6 +1,6 @@
-T16895c.hs:7:16:
- Non-variable expression is not allowed in an infix expression
+T16895c.hs:7:15: error:
+ • Non-variable expression is not allowed in an infix expression
When splicing a TH expression: (1 `GHC.Base.id GHC.Base.id`)
- In the untyped splice:
+ • In the untyped splice:
$(infixE (Just [| 1 |]) [| id id |] Nothing)
diff --git a/testsuite/tests/th/T16895d.stderr b/testsuite/tests/th/T16895d.stderr
index 57ba8725ba..2832aee9be 100644
--- a/testsuite/tests/th/T16895d.stderr
+++ b/testsuite/tests/th/T16895d.stderr
@@ -1,6 +1,6 @@
-T16895d.hs:7:16:
- Non-variable expression is not allowed in an infix expression
+T16895d.hs:7:15: error:
+ • Non-variable expression is not allowed in an infix expression
When splicing a TH expression: 1 `GHC.Base.id GHC.Base.id` 2
- In the untyped splice:
+ • In the untyped splice:
$(infixE (Just [| 1 |]) [| (id id) |] (Just [| 2 |]))
diff --git a/testsuite/tests/th/T16895e.stderr b/testsuite/tests/th/T16895e.stderr
index 90884a09da..43d7ac460e 100644
--- a/testsuite/tests/th/T16895e.stderr
+++ b/testsuite/tests/th/T16895e.stderr
@@ -1,5 +1,5 @@
-T16895e.hs:7:16:
- Non-variable expression is not allowed in an infix expression
+T16895e.hs:7:15: error:
+ • Non-variable expression is not allowed in an infix expression
When splicing a TH expression: (`GHC.Base.id GHC.Base.id`)
- In the untyped splice: $(infixE Nothing [| id id |] Nothing)
+ • In the untyped splice: $(infixE Nothing [| id id |] Nothing)
diff --git a/testsuite/tests/th/T17379a.stderr b/testsuite/tests/th/T17379a.stderr
index ec98c5fb54..feee281ac2 100644
--- a/testsuite/tests/th/T17379a.stderr
+++ b/testsuite/tests/th/T17379a.stderr
@@ -1,4 +1,4 @@
-T17379a.hs:8:3:
+T17379a.hs:8:2: error:
GadtC must have at least one constructor name
When splicing a TH declaration: data T where :: T
diff --git a/testsuite/tests/th/T17379b.stderr b/testsuite/tests/th/T17379b.stderr
index 47410ecdd0..54285bde18 100644
--- a/testsuite/tests/th/T17379b.stderr
+++ b/testsuite/tests/th/T17379b.stderr
@@ -1,4 +1,4 @@
-T17379b.hs:8:3:
+T17379b.hs:8:2: error:
RecGadtC must have at least one constructor name
When splicing a TH declaration: data T where :: {} -> T
diff --git a/testsuite/tests/th/T17380.stderr b/testsuite/tests/th/T17380.stderr
index a2501a4cb4..85724eb549 100644
--- a/testsuite/tests/th/T17380.stderr
+++ b/testsuite/tests/th/T17380.stderr
@@ -5,7 +5,7 @@ T17380.hs:9:7: error:
• In the expression: Just "wat"
In an equation for ‘foo’: foo = Just "wat"
-T17380.hs:12:9: error:
+T17380.hs:12:8: error:
• Couldn't match expected type ‘Maybe String’
with actual type ‘Unit (Maybe [Char])’
• In the expression: Unit Just "wat"
@@ -17,7 +17,7 @@ T17380.hs:15:6: error:
• In the pattern: Just "wat"
In an equation for ‘baz’: baz (Just "wat") = Just "frerf"
-T17380.hs:18:8: error:
+T17380.hs:18:7: error:
• Couldn't match expected type ‘Maybe String’
with actual type ‘Unit (Maybe [Char])’
• In the pattern: Unit(Just "wat")
diff --git a/testsuite/tests/th/T17394.stderr b/testsuite/tests/th/T17394.stderr
index c4ad33a671..b4551f763d 100644
--- a/testsuite/tests/th/T17394.stderr
+++ b/testsuite/tests/th/T17394.stderr
@@ -1,8 +1,8 @@
-T17394.hs:10:13-65: Splicing type
+T17394.hs:10:12-66: Splicing type
infixT (conT ''Maybe) ''(:*:) (conT ''Maybe)
======>
(:*:) Maybe Maybe
-T17394.hs:9:13-67: Splicing type
+T17394.hs:9:12-68: Splicing type
infixT (promotedT 'Nothing) '(:*:) (promotedT 'Nothing)
======>
'(:*:) 'Nothing 'Nothing
diff --git a/testsuite/tests/th/T17461.stderr b/testsuite/tests/th/T17461.stderr
index cc730400bf..f7b9f4b87c 100644
--- a/testsuite/tests/th/T17461.stderr
+++ b/testsuite/tests/th/T17461.stderr
@@ -1,4 +1,4 @@
-T17461.hs:(8,3)-(10,6): Splicing declarations
+T17461.hs:(8,2)-(10,7): Splicing declarations
[d| type (:+:) :: Type -> Type -> Type
type (:+:) = Either |]
diff --git a/testsuite/tests/th/T2597b.stderr b/testsuite/tests/th/T2597b.stderr
index 0e897ccfcb..aba3925113 100644
--- a/testsuite/tests/th/T2597b.stderr
+++ b/testsuite/tests/th/T2597b.stderr
@@ -1,5 +1,5 @@
-T2597b.hs:8:8:
- Empty stmt list in do-block
- When splicing a TH expression: do
- In the untyped splice: $mkBug2
+T2597b.hs:8:9: error:
+ • Empty stmt list in do-block
+ When splicing a TH expression: do
+ • In the untyped splice: $mkBug2
diff --git a/testsuite/tests/th/T2674.stderr b/testsuite/tests/th/T2674.stderr
index 0d9a3826ff..9c7f0baff7 100644
--- a/testsuite/tests/th/T2674.stderr
+++ b/testsuite/tests/th/T2674.stderr
@@ -1,4 +1,4 @@
-T2674.hs:9:3:
+T2674.hs:9:2: error:
Function binding for ‘foo’ has no equations
When splicing a TH declaration:
diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr
index d68be6d1fc..a9b8bed980 100644
--- a/testsuite/tests/th/T3177a.stderr
+++ b/testsuite/tests/th/T3177a.stderr
@@ -1,5 +1,5 @@
-T3177a.hs:8:8: error:
+T3177a.hs:8:7: error:
• Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
• In the type signature: f :: (Int Int)
diff --git a/testsuite/tests/th/T3319.stderr b/testsuite/tests/th/T3319.stderr
index b88b10f90f..7ecaf248cc 100644
--- a/testsuite/tests/th/T3319.stderr
+++ b/testsuite/tests/th/T3319.stderr
@@ -1,4 +1,4 @@
-T3319.hs:8:3-93: Splicing declarations
+T3319.hs:8:2-94: Splicing declarations
return
[ForeignD
(ImportF
diff --git a/testsuite/tests/th/T3395.stderr b/testsuite/tests/th/T3395.stderr
index 3c51176191..a9bcdbedba 100644
--- a/testsuite/tests/th/T3395.stderr
+++ b/testsuite/tests/th/T3395.stderr
@@ -1,11 +1,11 @@
-T3395.hs:6:9:
- Illegal last statement of a list comprehension:
- r1 <- undefined
- (It should be an expression.)
- When splicing a TH expression: [r1 <- undefined | undefined]
- In the untyped splice:
- $(return
- $ CompE
- [NoBindS (VarE $ mkName "undefined"),
- BindS (VarP $ mkName "r1") (VarE $ mkName "undefined")])
+T3395.hs:6:8: error:
+ • Illegal last statement of a list comprehension:
+ r1 <- undefined
+ (It should be an expression.)
+ When splicing a TH expression: [r1 <- undefined | undefined]
+ • In the untyped splice:
+ $(return
+ $ CompE
+ [NoBindS (VarE $ mkName "undefined"),
+ BindS (VarP $ mkName "r1") (VarE $ mkName "undefined")])
diff --git a/testsuite/tests/th/T3600.stderr b/testsuite/tests/th/T3600.stderr
index 4f63ef191a..b0ea19da58 100644
--- a/testsuite/tests/th/T3600.stderr
+++ b/testsuite/tests/th/T3600.stderr
@@ -1,2 +1,2 @@
-T3600.hs:5:3-6: Splicing declarations
+T3600.hs:5:2-7: Splicing declarations
test ======> myFunction = (testFun1 [], testFun2 [], testFun2 "x")
diff --git a/testsuite/tests/th/T3899.stderr b/testsuite/tests/th/T3899.stderr
index 2b4a76a4e5..3c4a707409 100644
--- a/testsuite/tests/th/T3899.stderr
+++ b/testsuite/tests/th/T3899.stderr
@@ -1,2 +1,2 @@
-T3899.hs:6:7-19: Splicing expression
+T3899.hs:6:6-20: Splicing expression
nestedTuple 3 ======> \ (Cons x (Cons x (Cons x Nil))) -> (x, x, x)
diff --git a/testsuite/tests/th/T4436.stderr b/testsuite/tests/th/T4436.stderr
index d87bfc1a2f..f7ed0e12fe 100644
--- a/testsuite/tests/th/T4436.stderr
+++ b/testsuite/tests/th/T4436.stderr
@@ -1,5 +1,5 @@
-T4436.hs:5:7-56: Splicing expression
- return (LitE (StringL "hello/ngoodbye/nand then"))
+T4436.hs:5:6-57: Splicing expression
+ return (LitE (StringL "hello\ngoodbye\nand then"))
======>
"hello
goodbye
diff --git a/testsuite/tests/th/T5217.stderr b/testsuite/tests/th/T5217.stderr
index 30797a8934..04b4d2526d 100644
--- a/testsuite/tests/th/T5217.stderr
+++ b/testsuite/tests/th/T5217.stderr
@@ -1,4 +1,4 @@
-T5217.hs:(6,3)-(9,53): Splicing declarations
+T5217.hs:(6,2)-(9,54): Splicing declarations
[d| data T a b
where
T1 :: Int -> T Int Char
diff --git a/testsuite/tests/th/T5290.stderr b/testsuite/tests/th/T5290.stderr
index 19c962a9a0..f595e55d18 100644
--- a/testsuite/tests/th/T5290.stderr
+++ b/testsuite/tests/th/T5290.stderr
@@ -1,13 +1,9 @@
-T5290.hs:(7,4)-(9,77): Splicing declarations
+T5290.hs:(7,2)-(9,79): Splicing declarations
let n = mkName "T"
in
return
[DataD
- []
- n
- []
- Nothing
- [NormalC n [(Bang SourceUnpack SourceStrict, ConT ''Int)]]
- []]
+ [] n [] Nothing
+ [NormalC n [(Bang SourceUnpack SourceStrict, ConT ''Int)]] []]
======>
data T = T {-# UNPACK #-} !Int
diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr
index cc1df54bed..6561e08032 100644
--- a/testsuite/tests/th/T5358.stderr
+++ b/testsuite/tests/th/T5358.stderr
@@ -34,8 +34,8 @@ T5358.hs:14:12: error:
runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
CallStack (from HasCallStack):
error, called at T5358.hs:15:18 in main:T5358
- Code: do VarI _ t _ <- reify (mkName "prop_x1")
- error $ ("runTest called error: " ++ pprint t)
+ Code: (do VarI _ t _ <- reify (mkName "prop_x1")
+ error $ ("runTest called error: " ++ pprint t))
• In the untyped splice:
$(do VarI _ t _ <- reify (mkName "prop_x1")
error $ ("runTest called error: " ++ pprint t))
diff --git a/testsuite/tests/th/T5508.stderr b/testsuite/tests/th/T5508.stderr
index 7000204913..5511ec6134 100644
--- a/testsuite/tests/th/T5508.stderr
+++ b/testsuite/tests/th/T5508.stderr
@@ -1,4 +1,4 @@
-T5508.hs:(7,9)-(9,28): Splicing expression
+T5508.hs:(7,8)-(9,29): Splicing expression
do let x = mkName "x"
v = return (LamE [VarP x] $ VarE x)
[| $v . id |]
diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr
index 3564b8cb2a..4be063203a 100644
--- a/testsuite/tests/th/T5700.stderr
+++ b/testsuite/tests/th/T5700.stderr
@@ -1,4 +1,4 @@
-T5700.hs:8:3-9: Splicing declarations
+T5700.hs:8:2-10: Splicing declarations
mkC ''D
======>
instance C D where
diff --git a/testsuite/tests/th/T5795.stderr b/testsuite/tests/th/T5795.stderr
index 79e9f92d17..95af718c98 100644
--- a/testsuite/tests/th/T5795.stderr
+++ b/testsuite/tests/th/T5795.stderr
@@ -1,6 +1,6 @@
-T5795.hs:9:6:
- GHC stage restriction:
- ‘ty’ is used in a top-level splice, quasi-quote, or annotation,
- and must be imported, not defined locally
- In the untyped splice: $ty
+T5795.hs:9:7: error:
+ • GHC stage restriction:
+ ‘ty’ is used in a top-level splice, quasi-quote, or annotation,
+ and must be imported, not defined locally
+ • In the untyped splice: $ty
diff --git a/testsuite/tests/th/T5883.stderr b/testsuite/tests/th/T5883.stderr
index aa87a41052..04db65b7ed 100644
--- a/testsuite/tests/th/T5883.stderr
+++ b/testsuite/tests/th/T5883.stderr
@@ -1,4 +1,4 @@
-T5883.hs:(7,4)-(12,4): Splicing declarations
+T5883.hs:(7,2)-(12,5): Splicing declarations
[d| data Unit = Unit
instance Show Unit where
diff --git a/testsuite/tests/th/T5971.stderr b/testsuite/tests/th/T5971.stderr
index d48c2255bd..c8164cd1df 100644
--- a/testsuite/tests/th/T5971.stderr
+++ b/testsuite/tests/th/T5971.stderr
@@ -1,7 +1,7 @@
-T5971.hs:6:7:
- The exact Name ‘x’ is not in scope
- Probable cause: you used a unique Template Haskell name (NameU),
- perhaps via newName, but did not bind it
- If that's it, then -ddump-splices might be useful
- In the untyped splice: $(newName "x" >>= varE)
+T5971.hs:6:6: error:
+ • The exact Name ‘x’ is not in scope
+ Probable cause: you used a unique Template Haskell name (NameU),
+ perhaps via newName, but did not bind it
+ If that's it, then -ddump-splices might be useful
+ • In the untyped splice: $(newName "x" >>= varE)
diff --git a/testsuite/tests/th/T5976.stderr b/testsuite/tests/th/T5976.stderr
index f4e9568927..7d815f2b30 100644
--- a/testsuite/tests/th/T5976.stderr
+++ b/testsuite/tests/th/T5976.stderr
@@ -4,4 +4,4 @@ T5976.hs:1:1: error:
bar
CallStack (from HasCallStack):
error, called at T5976.hs:3:21 in main:Main
- Code: error ("foo " ++ error "bar")
+ Code: (error ("foo " ++ error "bar"))
diff --git a/testsuite/tests/th/T5984.stderr b/testsuite/tests/th/T5984.stderr
index 2e612c7e9e..3bd89f1552 100644
--- a/testsuite/tests/th/T5984.stderr
+++ b/testsuite/tests/th/T5984.stderr
@@ -1,8 +1,3 @@
-T5984.hs:7:1-3: Splicing declarations
- nt
- ======>
- newtype Foo = Foo Int
-T5984.hs:8:1-3: Splicing declarations
- dt
- ======>
- data Bar = Bar Int
+T5984.hs:7:2-3: Splicing declarations
+ nt ======> newtype Foo = Foo Int
+T5984.hs:8:2-3: Splicing declarations dt ======> data Bar = Bar Int
diff --git a/testsuite/tests/th/T6018th.stderr b/testsuite/tests/th/T6018th.stderr
index b905fe8bf1..c141bfc44a 100644
--- a/testsuite/tests/th/T6018th.stderr
+++ b/testsuite/tests/th/T6018th.stderr
@@ -1,6 +1,6 @@
-T6018th.hs:98:4: error:
+T6018th.hs:98:2: error:
Type family equation right-hand sides overlap; this violates
the family's injectivity annotation:
- H Int Int Int = Bool -- Defined at T6018th.hs:98:4
- H Int Char Bool = Bool -- Defined at T6018th.hs:98:4
+ H Int Int Int = Bool -- Defined at T6018th.hs:98:2
+ H Int Char Bool = Bool -- Defined at T6018th.hs:98:2
diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr
index 07d17c9da3..1681b45f51 100644
--- a/testsuite/tests/th/T7241.stderr
+++ b/testsuite/tests/th/T7241.stderr
@@ -1,8 +1,8 @@
-T7241.hs:7:3: error:
+T7241.hs:7:2: error:
Same exact name in multiple name-spaces:
- type constructor or class ‘Foo’, declared at: T7241.hs:7:3
- data constructor ‘Foo’, declared at: T7241.hs:7:3
+ type constructor or class ‘Foo’, declared at: T7241.hs:7:2
+ data constructor ‘Foo’, declared at: T7241.hs:7:2
Probable cause: you bound a unique Template Haskell name (NameU),
perhaps via newName, in different name-spaces.
If that's it, then -ddump-splices might be useful
diff --git a/testsuite/tests/th/T7477.stderr b/testsuite/tests/th/T7477.stderr
index f94de686d0..7aee71ea74 100644
--- a/testsuite/tests/th/T7477.stderr
+++ b/testsuite/tests/th/T7477.stderr
@@ -1,3 +1,3 @@
-T7477.hs:10:4: Warning:
+T7477.hs:10:2: warning:
type instance T7477.F GHC.Types.Int = GHC.Types.Bool
diff --git a/testsuite/tests/th/T7484.stderr b/testsuite/tests/th/T7484.stderr
index 3ffe123361..5964a2f73c 100644
--- a/testsuite/tests/th/T7484.stderr
+++ b/testsuite/tests/th/T7484.stderr
@@ -1,4 +1,4 @@
-T7484.hs:7:4:
+T7484.hs:7:2: error:
Illegal variable name: ‘a ’
When splicing a TH declaration: a = 5
diff --git a/testsuite/tests/th/T7532.stderr b/testsuite/tests/th/T7532.stderr
index baaf04f3f5..d807c37db1 100644
--- a/testsuite/tests/th/T7532.stderr
+++ b/testsuite/tests/th/T7532.stderr
@@ -3,7 +3,7 @@
instance C Bool where
data D Bool = T7532.MkD
-T7532.hs:11:3-7: Splicing declarations
+T7532.hs:11:2-8: Splicing declarations
bang'
======>
instance C Int where
diff --git a/testsuite/tests/th/T7667a.stderr b/testsuite/tests/th/T7667a.stderr
index ca8b8f2145..b9807f0e0c 100644
--- a/testsuite/tests/th/T7667a.stderr
+++ b/testsuite/tests/th/T7667a.stderr
@@ -1,5 +1,5 @@
-T7667a.hs:8:12:
- Illegal variable name: ‘False’
- When splicing a TH expression: False
- In the untyped splice: $(return $ VarE (mkName "False"))
+T7667a.hs:8:10: error:
+ • Illegal variable name: ‘False’
+ When splicing a TH expression: False
+ • In the untyped splice: $(return $ VarE (mkName "False"))
diff --git a/testsuite/tests/th/T8412.stderr b/testsuite/tests/th/T8412.stderr
index 82b6116649..9e69b8e880 100644
--- a/testsuite/tests/th/T8412.stderr
+++ b/testsuite/tests/th/T8412.stderr
@@ -1,4 +1,4 @@
-T8412.hs:5:12:
- Illegal literal in type (type literals must not be negative): -1
- In the untyped splice: $(return $ LitT $ NumTyLit (- 1))
+T8412.hs:5:11: error:
+ • Illegal literal in type (type literals must not be negative): -1
+ • In the untyped splice: $(return $ LitT $ NumTyLit (- 1))
diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr
index 1a0fb75bd1..b6ff05a0a4 100644
--- a/testsuite/tests/th/T8577.stderr
+++ b/testsuite/tests/th/T8577.stderr
@@ -1,8 +1,8 @@
T8577.hs:9:11: error:
- Couldn't match type ‘Int’ with ‘Bool’
- Expected type: Q (TExp (A Bool))
- Actual type: Q (TExp (A Int))
- In the expression: y
- In the Template Haskell splice $$(y)
- In the expression: $$(y)
+ • Couldn't match type ‘Int’ with ‘Bool’
+ Expected type: Q (TExp (A Bool))
+ Actual type: Q (TExp (A Int))
+ • In the expression: y
+ In the Template Haskell splice $$(y)
+ In the expression: $$(y)
diff --git a/testsuite/tests/th/T8624.stdout b/testsuite/tests/th/T8624.stdout
index 0dcc7b0718..6286ee26d2 100644
--- a/testsuite/tests/th/T8624.stdout
+++ b/testsuite/tests/th/T8624.stdout
@@ -1,2 +1,2 @@
--- T8624.hs:(7,3)-(8,43): Splicing declarations
+-- T8624.hs:(7,2)-(8,44): Splicing declarations
data THDec = THDec
diff --git a/testsuite/tests/th/T8759.stderr b/testsuite/tests/th/T8759.stderr
index b980c00293..d3cde8b0a8 100644
--- a/testsuite/tests/th/T8759.stderr
+++ b/testsuite/tests/th/T8759.stderr
@@ -1,3 +1,3 @@
-T8759.hs:9:4: warning:
+T8759.hs:9:2: warning:
PatSynI T8759.P (ForallT [] [] (ForallT [] [] (TupleT 0)))
diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr
index 96e5d8a9fc..4dbbfe620a 100644
--- a/testsuite/tests/th/T8932.stderr
+++ b/testsuite/tests/th/T8932.stderr
@@ -1,5 +1,5 @@
T8932.hs:11:1: error:
Multiple declarations of ‘foo’
- Declared at: T8932.hs:5:3
+ Declared at: T8932.hs:5:2
T8932.hs:11:1
diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr
index 7b5f400f6f..00181fa2db 100644
--- a/testsuite/tests/th/T8987.stderr
+++ b/testsuite/tests/th/T8987.stderr
@@ -5,4 +5,4 @@ T8987.hs:1:1: error:
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
undefined, called at T8987.hs:6:23 in main:T8987
- Code: reportWarning ['1', undefined] >> return []
+ Code: (reportWarning ['1', undefined] >> return [])
diff --git a/testsuite/tests/th/TH_1tuple.stderr b/testsuite/tests/th/TH_1tuple.stderr
index 3acb218b6e..07b6584242 100644
--- a/testsuite/tests/th/TH_1tuple.stderr
+++ b/testsuite/tests/th/TH_1tuple.stderr
@@ -1,5 +1,5 @@
-TH_1tuple.hs:11:7: error:
+TH_1tuple.hs:11:6: error:
• Expecting one more argument to ‘Unit’
Expected a type, but ‘Unit’ has kind ‘* -> *’
• In an expression type signature: Unit
diff --git a/testsuite/tests/th/TH_Promoted1Tuple.stderr b/testsuite/tests/th/TH_Promoted1Tuple.stderr
index 495fb1c386..d75a6260fa 100644
--- a/testsuite/tests/th/TH_Promoted1Tuple.stderr
+++ b/testsuite/tests/th/TH_Promoted1Tuple.stderr
@@ -1,3 +1,3 @@
-TH_Promoted1Tuple.hs:7:3: error:
+TH_Promoted1Tuple.hs:7:2: error:
Illegal type: ‘'Unit Int’ Perhaps you intended to use DataKinds
diff --git a/testsuite/tests/th/TH_PromotedList.stderr b/testsuite/tests/th/TH_PromotedList.stderr
index fde888ff88..d3eba9ac0e 100644
--- a/testsuite/tests/th/TH_PromotedList.stderr
+++ b/testsuite/tests/th/TH_PromotedList.stderr
@@ -1,3 +1,3 @@
-TH_PromotedList.hs:11:3: warning:
+TH_PromotedList.hs:11:2: warning:
'(:) GHC.Types.Int ('(:) GHC.Types.Bool '[])
diff --git a/testsuite/tests/th/TH_PromotedTuple.stderr b/testsuite/tests/th/TH_PromotedTuple.stderr
index 92792a361d..29b60f08fd 100644
--- a/testsuite/tests/th/TH_PromotedTuple.stderr
+++ b/testsuite/tests/th/TH_PromotedTuple.stderr
@@ -1,9 +1,9 @@
-TH_PromotedTuple.hs:(14,32)-(16,43): Splicing type
+TH_PromotedTuple.hs:(14,31)-(16,44): Splicing type
do ty <- [t| '(Int, False) |]
reportWarning (show ty)
return ty
======>
- '(Int, 'False)
+ '(Int, 'False)
-TH_PromotedTuple.hs:14:32: warning:
+TH_PromotedTuple.hs:14:31: warning:
AppT (AppT (PromotedTupleT 2) (ConT GHC.Types.Int)) (PromotedT GHC.Types.False)
diff --git a/testsuite/tests/th/TH_RichKinds.stderr b/testsuite/tests/th/TH_RichKinds.stderr
index eb402902ac..920e424e52 100644
--- a/testsuite/tests/th/TH_RichKinds.stderr
+++ b/testsuite/tests/th/TH_RichKinds.stderr
@@ -1,9 +1,9 @@
-TH_RichKinds.hs:12:3: warning:
+TH_RichKinds.hs:12:2: warning:
forall a_0 . (a_0 :: GHC.Types.Bool)
forall a_1 . (a_1 :: Constraint)
forall a_2 . (a_2 :: [*])
forall a_3 . (a_3 :: (*, GHC.Types.Bool))
forall a_4 . (a_4 :: ())
-forall a_5 . (a_5 :: (* -> GHC.Types.Bool) ->
- (*, * -> *) -> GHC.Types.Bool)
+forall a_5 .
+(a_5 :: (* -> GHC.Types.Bool) -> (*, * -> *) -> GHC.Types.Bool)
diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr
index a0b29a15e3..ae842d43a6 100644
--- a/testsuite/tests/th/TH_RichKinds2.stderr
+++ b/testsuite/tests/th/TH_RichKinds2.stderr
@@ -1,5 +1,5 @@
-TH_RichKinds2.hs:25:4: warning:
+TH_RichKinds2.hs:25:2: warning:
data SMaybe_0 :: (k_0 -> *) -> GHC.Maybe.Maybe k_0 -> * where
SNothing_2 :: SMaybe_0 s_3 'GHC.Maybe.Nothing
SJust_4 :: (s_5 a_6) -> SMaybe_0 s_5 ('GHC.Maybe.Just a_6)
diff --git a/testsuite/tests/th/TH_Roles1.stderr b/testsuite/tests/th/TH_Roles1.stderr
index 952b3317ce..2b665852ca 100644
--- a/testsuite/tests/th/TH_Roles1.stderr
+++ b/testsuite/tests/th/TH_Roles1.stderr
@@ -1,5 +1,5 @@
-TH_Roles1.hs:7:4:
- Illegal role annotation for T;
- did you intend to use RoleAnnotations?
- while checking a role annotation for ‘T’
+TH_Roles1.hs:7:2: error:
+ • Illegal role annotation for T;
+ did you intend to use RoleAnnotations?
+ • while checking a role annotation for ‘T’
diff --git a/testsuite/tests/th/TH_StaticPointers02.stderr b/testsuite/tests/th/TH_StaticPointers02.stderr
index e6f6963434..a89ad11b0d 100644
--- a/testsuite/tests/th/TH_StaticPointers02.stderr
+++ b/testsuite/tests/th/TH_StaticPointers02.stderr
@@ -1,12 +1,12 @@
-TH_StaticPointers02.hs:11:34:
- static forms cannot be used in splices: static 'a'
- In the untyped splice:
- $(case staticKey (static 'a') of {
- Fingerprint w0 w1
- -> let
- w0i = ...
- ....
- in
- [| fmap (\ p -> ...) $ unsafeLookupStaticPtr
- $ Fingerprint (fromIntegral w0i) (fromIntegral w1i) |] })
+TH_StaticPointers02.hs:11:34: error:
+ • static forms cannot be used in splices: static 'a'
+ • In the untyped splice:
+ $(case staticKey (static 'a') of {
+ Fingerprint w0 w1
+ -> let
+ w0i = ...
+ w1i = ...
+ in
+ [| fmap (\ p -> deRefStaticPtr p :: Char) $ unsafeLookupStaticPtr
+ $ Fingerprint (fromIntegral w0i) (fromIntegral w1i) |] })
diff --git a/testsuite/tests/th/TH_TyInstWhere1.stderr b/testsuite/tests/th/TH_TyInstWhere1.stderr
index 0d07db83d1..4f5d278afd 100644
--- a/testsuite/tests/th/TH_TyInstWhere1.stderr
+++ b/testsuite/tests/th/TH_TyInstWhere1.stderr
@@ -1,8 +1,8 @@
-TH_TyInstWhere1.hs:(5,3)-(7,24): Splicing declarations
+TH_TyInstWhere1.hs:(5,2)-(7,25): Splicing declarations
[d| type family F (a :: k) (b :: k) :: Bool where
F a a = True
F a b = False |]
======>
type family F (a :: k) (b :: k) :: Bool where
- F a a = 'True
- F a b = 'False
+ F a a = 'True
+ F a b = 'False
diff --git a/testsuite/tests/th/TH_TyInstWhere2.stderr b/testsuite/tests/th/TH_TyInstWhere2.stderr
index 717fb0e170..c79af948a6 100644
--- a/testsuite/tests/th/TH_TyInstWhere2.stderr
+++ b/testsuite/tests/th/TH_TyInstWhere2.stderr
@@ -1,10 +1,10 @@
-TH_TyInstWhere2.hs:8:4: warning:
+TH_TyInstWhere2.hs:8:2: warning:
type family F_0 (a_1 :: k_2) (b_3 :: k_2) :: GHC.Types.Bool where
F_0 a_4 a_4 = 'GHC.Types.True
F_0 a_5 b_6 = 'GHC.Types.False
-TH_TyInstWhere2.hs:14:4: warning:
+TH_TyInstWhere2.hs:14:2: warning:
type family F1_0 (a_1 :: k_2) :: * where
F1_0 @* GHC.Types.Int = GHC.Types.Bool
F1_0 @GHC.Types.Bool 'GHC.Types.False = GHC.Types.Char
diff --git a/testsuite/tests/th/TH_dupdecl.stderr b/testsuite/tests/th/TH_dupdecl.stderr
index e08af85233..c44ba63098 100644
--- a/testsuite/tests/th/TH_dupdecl.stderr
+++ b/testsuite/tests/th/TH_dupdecl.stderr
@@ -1,5 +1,5 @@
-TH_dupdecl.hs:10:4:
+TH_dupdecl.hs:10:2: error:
Multiple declarations of ‘x’
- Declared at: TH_dupdecl.hs:8:4
- TH_dupdecl.hs:10:4
+ Declared at: TH_dupdecl.hs:8:2
+ TH_dupdecl.hs:10:2
diff --git a/testsuite/tests/th/TH_exn1.stderr b/testsuite/tests/th/TH_exn1.stderr
index 63548613d8..69c854e244 100644
--- a/testsuite/tests/th/TH_exn1.stderr
+++ b/testsuite/tests/th/TH_exn1.stderr
@@ -1,6 +1,6 @@
-TH_exn1.hs:1:1:
+TH_exn1.hs:1:1: error:
Exception when trying to run compile-time code:
TH_exn1.hs:(9,4)-(10,23): Non-exhaustive patterns in case
- Code: case reverse "no" of { [] -> return [] }
+ Code: (case reverse "no" of { [] -> return [] })
diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr
index 3ccc9e1c0c..582928c08b 100644
--- a/testsuite/tests/th/TH_exn2.stderr
+++ b/testsuite/tests/th/TH_exn2.stderr
@@ -2,5 +2,5 @@
TH_exn2.hs:1:1: error:
Exception when trying to run compile-time code:
Prelude.tail: empty list
- Code: do ds <- [d| |]
- return (tail ds)
+ Code: (do ds <- [d| |]
+ return (tail ds))
diff --git a/testsuite/tests/th/TH_fail.stderr b/testsuite/tests/th/TH_fail.stderr
index b73acbbb22..6df144dae4 100644
--- a/testsuite/tests/th/TH_fail.stderr
+++ b/testsuite/tests/th/TH_fail.stderr
@@ -1,2 +1,2 @@
-TH_fail.hs:7:4: Code not written yet...
+TH_fail.hs:7:2: error: Code not written yet...
diff --git a/testsuite/tests/th/TH_foreignCallingConventions.stderr b/testsuite/tests/th/TH_foreignCallingConventions.stderr
index dae994539d..df09310652 100644
--- a/testsuite/tests/th/TH_foreignCallingConventions.stderr
+++ b/testsuite/tests/th/TH_foreignCallingConventions.stderr
@@ -8,20 +8,20 @@ foreign import stdcall safe "bay" bay :: (GHC.Types.Int ->
GHC.Types.IO GHC.Types.Int
foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int ->
GHC.Types.IO GHC.Base.String
-TH_foreignCallingConventions.hs:(13,4)-(23,25): Splicing declarations
+TH_foreignCallingConventions.hs:(13,2)-(24,2): Splicing declarations
do let fi cconv safety lbl name ty
= ForeignD (ImportF cconv safety lbl name ty)
dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |]
dec2 <- fi Prim Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |]
dec3 <- fi CApi Unsafe "baz" (mkName "baz")
- <$> [t| Double -> IO () |]
+ <$> [t| Double -> IO () |]
dec4 <- fi StdCall Safe "bay" (mkName "bay")
- <$> [t| (Int -> Bool) -> IO Int |]
+ <$> [t| (Int -> Bool) -> IO Int |]
dec5 <- fi JavaScript Unsafe "bax" (mkName "bax")
- <$> [t| Ptr Int -> IO String |]
+ <$> [t| Ptr Int -> IO String |]
runIO
- $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5]
- >> hFlush stdout
+ $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5]
+ >> hFlush stdout
return [dec1, dec2]
======>
foreign import ccall interruptible "&" foo :: Ptr ()
diff --git a/testsuite/tests/th/TH_foreignInterruptible.stderr b/testsuite/tests/th/TH_foreignInterruptible.stderr
index 4afc38aab1..28440eb8f0 100644
--- a/testsuite/tests/th/TH_foreignInterruptible.stderr
+++ b/testsuite/tests/th/TH_foreignInterruptible.stderr
@@ -1,11 +1,8 @@
-TH_foreignInterruptible.hs:8:3-100: Splicing declarations
+TH_foreignInterruptible.hs:8:2-101: Splicing declarations
return
[ForeignD
(ImportF
- CCall
- Interruptible
- "&"
- (mkName "foo")
+ CCall Interruptible "&" (mkName "foo")
(AppT (ConT ''Ptr) (ConT ''())))]
======>
foreign import ccall interruptible "&" foo :: Ptr ()
diff --git a/testsuite/tests/th/TH_genEx.stderr b/testsuite/tests/th/TH_genEx.stderr
index 8f2d5926e9..2c4c51c26c 100644
--- a/testsuite/tests/th/TH_genEx.stderr
+++ b/testsuite/tests/th/TH_genEx.stderr
@@ -1,5 +1,5 @@
-TH_genEx.hs:13:3-30: Splicing declarations
+TH_genEx.hs:13:2-31: Splicing declarations
genAny (reify ''MyInterface)
======>
data AnyMyInterface1111
- = forall a. MyInterface a => AnyMyInterface1111 a
+ = forall a. MyInterface a => AnyMyInterface1111 a
diff --git a/testsuite/tests/th/TH_implicitParamsErr1.stderr b/testsuite/tests/th/TH_implicitParamsErr1.stderr
index 82324810ad..56acdfdabb 100644
--- a/testsuite/tests/th/TH_implicitParamsErr1.stderr
+++ b/testsuite/tests/th/TH_implicitParamsErr1.stderr
@@ -1,4 +1,4 @@
-TH_implicitParamsErr1.hs:5:3: error:
+TH_implicitParamsErr1.hs:5:2: error:
Implicit parameter binding only allowed in let or where
When splicing a TH declaration: ?x = 1
diff --git a/testsuite/tests/th/TH_implicitParamsErr2.stderr b/testsuite/tests/th/TH_implicitParamsErr2.stderr
index f93aa55a58..faa2a9e90b 100644
--- a/testsuite/tests/th/TH_implicitParamsErr2.stderr
+++ b/testsuite/tests/th/TH_implicitParamsErr2.stderr
@@ -1,5 +1,5 @@
-TH_implicitParamsErr2.hs:5:10: error:
+TH_implicitParamsErr2.hs:5:9: error:
• Implicit parameters mixed with other bindings
When splicing a TH expression: let {?x = 1; y = 2}
in y
diff --git a/testsuite/tests/th/TH_implicitParamsErr3.stderr b/testsuite/tests/th/TH_implicitParamsErr3.stderr
index fe3bf67259..a83ead7a0a 100644
--- a/testsuite/tests/th/TH_implicitParamsErr3.stderr
+++ b/testsuite/tests/th/TH_implicitParamsErr3.stderr
@@ -1,5 +1,5 @@
-TH_implicitParamsErr3.hs:5:16: error:
+TH_implicitParamsErr3.hs:5:15: error:
• Illegal variable name: ‘invalid name’
When splicing a TH expression:
let ?invalid name = "hi"
diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.stderr b/testsuite/tests/th/TH_invalid_add_top_decl.stderr
index 9124c2d669..0e8f6b66c2 100644
--- a/testsuite/tests/th/TH_invalid_add_top_decl.stderr
+++ b/testsuite/tests/th/TH_invalid_add_top_decl.stderr
@@ -1,5 +1,5 @@
-TH_invalid_add_top_decl.hs:5:3:
+TH_invalid_add_top_decl.hs:5:2: error:
Error in a declaration passed to addTopDecls:
Empty stmt list in do-block
When splicing a TH declaration: emptyDo = do
diff --git a/testsuite/tests/th/TH_pragma.stderr b/testsuite/tests/th/TH_pragma.stderr
index 1156adee27..0baf21c564 100644
--- a/testsuite/tests/th/TH_pragma.stderr
+++ b/testsuite/tests/th/TH_pragma.stderr
@@ -1,4 +1,4 @@
-TH_pragma.hs:(6,4)-(8,26): Splicing declarations
+TH_pragma.hs:(6,2)-(8,28): Splicing declarations
[d| foo :: Int -> Int
{-# NOINLINE foo #-}
foo x = x + 1 |]
@@ -6,7 +6,7 @@ TH_pragma.hs:(6,4)-(8,26): Splicing declarations
foo :: Int -> Int
{-# NOINLINE foo #-}
foo x = (x + 1)
-TH_pragma.hs:(10,4)-(12,31): Splicing declarations
+TH_pragma.hs:(10,2)-(12,33): Splicing declarations
[d| bar :: Num a => a -> a
{-# SPECIALISE INLINE [~1] bar :: Float -> Float #-}
bar x = x * 10 |]
diff --git a/testsuite/tests/th/TH_recover_warns.stderr b/testsuite/tests/th/TH_recover_warns.stderr
index c92ee71bc9..24bfb76f1d 100644
--- a/testsuite/tests/th/TH_recover_warns.stderr
+++ b/testsuite/tests/th/TH_recover_warns.stderr
@@ -1,10 +1,10 @@
-TH_recover_warns.hs:(9,19)-(10,63): Splicing expression
+TH_recover_warns.hs:(9,18)-(10,64): Splicing expression
recover
(stringE "splice failed") [| let x = "a" in let x = "b" in x |]
======>
let x = "a" in let x = "b" in x
-TH_recover_warns.hs:9:19: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)]
+TH_recover_warns.hs:9:18: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)]
Defined but not used: ‘x’
TH_recover_warns.hs:10:34: warning: [-Wunused-local-binds (in -Wextra, -Wunused-binds)]
diff --git a/testsuite/tests/th/TH_runIO.stderr b/testsuite/tests/th/TH_runIO.stderr
index 5d5a4f2efc..50af621620 100644
--- a/testsuite/tests/th/TH_runIO.stderr
+++ b/testsuite/tests/th/TH_runIO.stderr
@@ -1,6 +1,6 @@
-TH_runIO.hs:12:7:
- Exception when trying to run compile-time code:
- user error (hi)
- Code: runIO (fail "hi")
- In the untyped splice: $(runIO (fail "hi"))
+TH_runIO.hs:12:7: error:
+ • Exception when trying to run compile-time code:
+ user error (hi)
+ Code: (runIO (fail "hi"))
+ • In the untyped splice: $(runIO (fail "hi"))
diff --git a/testsuite/tests/th/TH_spliceD1.stderr b/testsuite/tests/th/TH_spliceD1.stderr
index 9e6fb5013a..77ae873562 100644
--- a/testsuite/tests/th/TH_spliceD1.stderr
+++ b/testsuite/tests/th/TH_spliceD1.stderr
@@ -1,6 +1,6 @@
-TH_spliceD1.hs:10:3:
- Conflicting definitions for ‘c’
- Bound at: TH_spliceD1.hs:10:3-5
- TH_spliceD1.hs:10:3-5
- In an equation for ‘f’
+TH_spliceD1.hs:10:2: error:
+ • Conflicting definitions for ‘c’
+ Bound at: TH_spliceD1.hs:10:2-6
+ TH_spliceD1.hs:10:2-6
+ • In an equation for ‘f’
diff --git a/testsuite/tests/th/TH_unresolvedInfix2.stderr b/testsuite/tests/th/TH_unresolvedInfix2.stderr
index 4a5577f6fc..50d56a02ff 100644
--- a/testsuite/tests/th/TH_unresolvedInfix2.stderr
+++ b/testsuite/tests/th/TH_unresolvedInfix2.stderr
@@ -1,11 +1,11 @@
-TH_unresolvedInfix2.hs:14:11:
- The operator ‘:+’ [infixl 6] of a section
- must have lower precedence than that of the operand,
- namely ‘:+’ [infixl 6]
- in the section: ‘:+ N :+ N’
- In the untyped splice:
- $(let
- plus = conE '(:+)
- n = conE 'N
- in infixE Nothing plus (Just $ uInfixE n plus n))
+TH_unresolvedInfix2.hs:14:9: error:
+ • The operator ‘:+’ [infixl 6] of a section
+ must have lower precedence than that of the operand,
+ namely ‘:+’ [infixl 6]
+ in the section: ‘:+ N :+ N’
+ • In the untyped splice:
+ $(let
+ plus = conE '(:+)
+ n = conE 'N
+ in infixE Nothing plus (Just $ uInfixE n plus n))
diff --git a/testsuite/tests/typecheck/should_fail/T14761b.stderr b/testsuite/tests/typecheck/should_fail/T14761b.stderr
index 08a319cde3..af557c4725 100644
--- a/testsuite/tests/typecheck/should_fail/T14761b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14761b.stderr
@@ -1,5 +1,2 @@
-T14761b.hs:5:21: error:
- Strictness annotation applied to a compound type.
- Did you mean to add parentheses?
- !(Maybe Int)
+T14761b.hs:5:19: error: Operator applied to too few arguments: !
diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr
index dd03a0a0ca..2b764caef9 100644
--- a/testsuite/tests/typecheck/should_fail/T15527.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15527.stderr
@@ -1,4 +1,8 @@
-T15527.hs:4:6: error:
- Pattern syntax in expression context: (.)@Int
- Did you mean to enable TypeApplications?
+T15527.hs:4:10: error:
+ Variable not in scope:
+ (@)
+ :: ((b0 -> c0) -> (a0 -> b0) -> a0 -> c0)
+ -> t0 -> (Int -> Int) -> (Int -> Int) -> Int -> Int
+
+T15527.hs:4:11: error: Data constructor not in scope: Int
diff --git a/testsuite/tests/typecheck/should_fail/T7210.stderr b/testsuite/tests/typecheck/should_fail/T7210.stderr
index 4d7cb38a4d..d0ca04a84e 100644
--- a/testsuite/tests/typecheck/should_fail/T7210.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7210.stderr
@@ -1,5 +1,7 @@
-T7210.hs:5:20: error:
- Strictness annotation applied to a compound type.
- Did you mean to add parentheses?
- !(IntMap Int)
+T7210.hs:5:19: error:
+ • Unexpected strictness annotation: !IntMap
+ strictness annotation cannot appear nested inside a type
+ • In the type ‘!IntMap Int’
+ In the definition of data constructor ‘C’
+ In the data declaration for ‘T’
diff --git a/utils/haddock b/utils/haddock
-Subproject d84d5a572b7ddaf471eccb39da620807ef3591d
+Subproject b6359cba90e5edfe549f933beeb00a13f01567b