Whitespace-sensitive bang patterns (#1087, #17162) wip/whitespace-and-lookahead
authorVladislav Zavialov <vlad.z.4096@gmail.com>
Wed, 30 Oct 2019 05:44:34 +0000 (08:44 +0300)
committerVladislav Zavialov <vlad.z.4096@gmail.com>
Wed, 27 Nov 2019 08:32:18 +0000 (11:32 +0300)
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.

172 files changed:
compiler/GHC/Hs/Expr.hs
compiler/main/DynFlags.hs
compiler/parser/ApiAnnotation.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/prelude/TysWiredIn.hs
compiler/rename/RnEnv.hs
compiler/rename/RnSplice.hs
docs/users_guide/bugs.rst
docs/users_guide/glasgow_exts.rst
docs/users_guide/using-warnings.rst
nofib
testsuite/tests/ghc-api/annotations/T10268.stdout
testsuite/tests/ghc-api/annotations/T10276.stdout
testsuite/tests/ghc-api/annotations/T10358.stdout
testsuite/tests/ghc-api/annotations/T10399.stdout
testsuite/tests/module/mod69.stderr
testsuite/tests/module/mod70.stderr
testsuite/tests/overloadedrecflds/should_fail/T11103.stderr
testsuite/tests/parser/should_compile/Proposal229f_instances.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/T1087.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/T16619.stderr [new file with mode: 0644]
testsuite/tests/parser/should_compile/all.T
testsuite/tests/parser/should_compile/proposal-229a.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/proposal-229b.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/proposal-229d.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/proposal-229e.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/proposal-229f.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/proposal-229f.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/T14588.stderr
testsuite/tests/parser/should_fail/T16270.stderr
testsuite/tests/parser/should_fail/T17162.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/T17162.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/T3811b.stderr
testsuite/tests/parser/should_fail/T3811c.stderr
testsuite/tests/parser/should_fail/T3811f.stderr
testsuite/tests/parser/should_fail/all.T
testsuite/tests/parser/should_fail/proposal-229c.hs [new file with mode: 0644]
testsuite/tests/parser/should_fail/proposal-229c.stderr [new file with mode: 0644]
testsuite/tests/parser/should_fail/strictnessDataCon_A.stderr
testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
testsuite/tests/plugins/plugins10.stdout
testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
testsuite/tests/printer/T13199.stdout
testsuite/tests/printer/T13550.stdout
testsuite/tests/printer/T13942.stdout
testsuite/tests/printer/T14289.stdout
testsuite/tests/printer/T14289b.stdout
testsuite/tests/printer/T14289c.stdout
testsuite/tests/rename/should_fail/T12879.stderr
testsuite/tests/rename/should_fail/rnfail016.stderr
testsuite/tests/rename/should_fail/rnfail016a.stderr
testsuite/tests/rename/should_fail/rnfail051.stderr
testsuite/tests/roles/should_compile/T16718.stderr
testsuite/tests/saks/should_compile/T17164.stderr
testsuite/tests/saks/should_compile/saks027.stderr
testsuite/tests/th/ClosedFam1TH.stderr
testsuite/tests/th/T10279.stderr
testsuite/tests/th/T10598_TH.stderr
testsuite/tests/th/T10603.stderr
testsuite/tests/th/T10638.stderr
testsuite/tests/th/T10796b.stderr
testsuite/tests/th/T10810.stderr
testsuite/tests/th/T10828a.stderr
testsuite/tests/th/T10828b.stderr
testsuite/tests/th/T11452.stderr
testsuite/tests/th/T12045TH1.stderr
testsuite/tests/th/T12387.stderr
testsuite/tests/th/T12411.stderr
testsuite/tests/th/T12478_4.stderr
testsuite/tests/th/T12530.stderr
testsuite/tests/th/T13776.stderr
testsuite/tests/th/T13837.stderr
testsuite/tests/th/T13856.stderr
testsuite/tests/th/T13968.stderr
testsuite/tests/th/T14204.stderr
testsuite/tests/th/T14646.stderr
testsuite/tests/th/T14681.stderr
testsuite/tests/th/T14817.stderr
testsuite/tests/th/T14869.stderr
testsuite/tests/th/T14875.stderr
testsuite/tests/th/T14888.stderr
testsuite/tests/th/T15243.stderr
testsuite/tests/th/T15270A.stderr
testsuite/tests/th/T15270B.stderr
testsuite/tests/th/T15324.stderr
testsuite/tests/th/T15331.stderr
testsuite/tests/th/T15360b.stderr
testsuite/tests/th/T15365.stderr
testsuite/tests/th/T15481.stderr
testsuite/tests/th/T15502.stderr-ws-32
testsuite/tests/th/T15502.stderr-ws-64
testsuite/tests/th/T15518.stderr
testsuite/tests/th/T15550.stderr
testsuite/tests/th/T15572.stderr
testsuite/tests/th/T15738.stderr
testsuite/tests/th/T16133.stderr
testsuite/tests/th/T16183.stderr
testsuite/tests/th/T16326_TH.stderr
testsuite/tests/th/T16666.stderr
testsuite/tests/th/T16895a.stderr
testsuite/tests/th/T16895b.stderr
testsuite/tests/th/T16895c.stderr
testsuite/tests/th/T16895d.stderr
testsuite/tests/th/T16895e.stderr
testsuite/tests/th/T17379a.stderr
testsuite/tests/th/T17379b.stderr
testsuite/tests/th/T17380.stderr
testsuite/tests/th/T17394.stderr
testsuite/tests/th/T17461.stderr
testsuite/tests/th/T2597b.stderr
testsuite/tests/th/T2674.stderr
testsuite/tests/th/T3177a.stderr
testsuite/tests/th/T3319.stderr
testsuite/tests/th/T3395.stderr
testsuite/tests/th/T3600.stderr
testsuite/tests/th/T3899.stderr
testsuite/tests/th/T4436.stderr
testsuite/tests/th/T5217.stderr
testsuite/tests/th/T5290.stderr
testsuite/tests/th/T5358.stderr
testsuite/tests/th/T5508.stderr
testsuite/tests/th/T5700.stderr
testsuite/tests/th/T5795.stderr
testsuite/tests/th/T5883.stderr
testsuite/tests/th/T5971.stderr
testsuite/tests/th/T5976.stderr
testsuite/tests/th/T5984.stderr
testsuite/tests/th/T6018th.stderr
testsuite/tests/th/T7241.stderr
testsuite/tests/th/T7477.stderr
testsuite/tests/th/T7484.stderr
testsuite/tests/th/T7532.stderr
testsuite/tests/th/T7667a.stderr
testsuite/tests/th/T8412.stderr
testsuite/tests/th/T8577.stderr
testsuite/tests/th/T8624.stdout
testsuite/tests/th/T8759.stderr
testsuite/tests/th/T8932.stderr
testsuite/tests/th/T8987.stderr
testsuite/tests/th/TH_1tuple.stderr
testsuite/tests/th/TH_Promoted1Tuple.stderr
testsuite/tests/th/TH_PromotedList.stderr
testsuite/tests/th/TH_PromotedTuple.stderr
testsuite/tests/th/TH_RichKinds.stderr
testsuite/tests/th/TH_RichKinds2.stderr
testsuite/tests/th/TH_Roles1.stderr
testsuite/tests/th/TH_StaticPointers02.stderr
testsuite/tests/th/TH_TyInstWhere1.stderr
testsuite/tests/th/TH_TyInstWhere2.stderr
testsuite/tests/th/TH_dupdecl.stderr
testsuite/tests/th/TH_exn1.stderr
testsuite/tests/th/TH_exn2.stderr
testsuite/tests/th/TH_fail.stderr
testsuite/tests/th/TH_foreignCallingConventions.stderr
testsuite/tests/th/TH_foreignInterruptible.stderr
testsuite/tests/th/TH_genEx.stderr
testsuite/tests/th/TH_implicitParamsErr1.stderr
testsuite/tests/th/TH_implicitParamsErr2.stderr
testsuite/tests/th/TH_implicitParamsErr3.stderr
testsuite/tests/th/TH_invalid_add_top_decl.stderr
testsuite/tests/th/TH_pragma.stderr
testsuite/tests/th/TH_recover_warns.stderr
testsuite/tests/th/TH_runIO.stderr
testsuite/tests/th/TH_spliceD1.stderr
testsuite/tests/th/TH_unresolvedInfix2.stderr
testsuite/tests/typecheck/should_fail/T14761b.stderr
testsuite/tests/typecheck/should_fail/T15527.stderr
testsuite/tests/typecheck/should_fail/T7210.stderr
utils/haddock

index 52d0448..7921a61 100644 (file)
@@ -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
index d86c064..d3cd657 100644 (file)
@@ -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,
index bfb39c8..ca88716 100644 (file)
@@ -258,9 +258,9 @@ data AnnKeywordId
     | AnnOpenEQ  -- ^ '[|'
     | AnnOpenEQU -- ^ '[|', unicode variant
     | AnnOpenP   -- ^ '('
-    | AnnOpenPE  -- ^ '$('
-    | AnnOpenPTE -- ^ '$$('
     | AnnOpenS   -- ^ '['
+    | AnnDollar          -- ^ prefix '$'   -- TemplateHaskell
+    | AnnDollarDollar    -- ^ prefix '$$'  -- TemplateHaskell
     | AnnPackageName
     | AnnPattern
     | AnnProc
index 2ada289..160cb8c 100644 (file)
@@ -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
index 5fea864..8ee4053 100644 (file)
@@ -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
index cb70078..9cccc7d 100644 (file)
@@ -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
index b1ba7bf..de7ec7e 100644 (file)
@@ -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
 
index c84e7bd..586548f 100644 (file)
@@ -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]
index 3e6d647..d9cc28e 100644 (file)
@@ -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)
index c0cffa0..4dc49f0 100644 (file)
@@ -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
index af3d48e..d23681e 100644 (file)
@@ -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.
 
 
 
index 62b644a..4649f86 100644 (file)
@@ -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
index a6cbac8..c9fe4e9 160000 (submodule)
--- a/nofib
+++ b/nofib
@@ -1 +1 @@
-Subproject commit a6cbac8fd8c69d85fddfde0a2686607e1ae22947
+Subproject commit c9fe4e92b88cd052d5fea8b713569d16c05ebf0e
index 3739b7b..502d5fc 100644 (file)
@@ -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]),
index 2ed6318..77b2dae 100644 (file)
@@ -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]),
index 604c7da..28f516c 100644 (file)
 ((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]),
index 75d94b3..b1e5a34 100644 (file)
 ((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])
index db74874..dea1611 100644 (file)
@@ -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 '@'
index 093f166..6e9f854 100644 (file)
@@ -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 '~'?
index b4f29fb..09606e0 100644 (file)
@@ -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 (file)
index 0000000..2bd5a8e
--- /dev/null
@@ -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 (file)
index 0000000..9ad85e2
--- /dev/null
@@ -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 (file)
index 0000000..b5dfb89
--- /dev/null
@@ -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
index 3d44e22..91aae13 100644 (file)
@@ -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 (file)
index 0000000..c773cee
--- /dev/null
@@ -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 (file)
index 0000000..9182623
--- /dev/null
@@ -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 (file)
index 0000000..24a57ca
--- /dev/null
@@ -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 (file)
index 0000000..d7fc35d
--- /dev/null
@@ -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 (file)
index 0000000..75b1341
--- /dev/null
@@ -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 (file)
index 0000000..310be06
--- /dev/null
@@ -0,0 +1,4 @@
+123
+123
+123
+123
index cb64103..2efd956 100644 (file)
@@ -1,4 +1,4 @@
 
 T14588.hs:3:19: error:
     Illegal bang-pattern (use BangPatterns):
-    ! x
+    !x
index f4e90e4..a74bdeb 100644 (file)
@@ -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 (file)
index 0000000..6419da7
--- /dev/null
@@ -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 (file)
index 0000000..d621e08
--- /dev/null
@@ -0,0 +1,4 @@
+
+T17162.hs:6:21: error:
+    Illegal bang-pattern (use BangPatterns):
+    !enc
index f4e44c6..65de1d5 100644 (file)
@@ -1,4 +1,4 @@
 
 T3811b.hs:4:14: error:
     Cannot parse data constructor in a data/newtype declaration:
-      ! B
+      !B
index 431318e..52f081b 100644 (file)
@@ -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
index 2d31fa8..783a89e 100644 (file)
@@ -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
index 2fc7f3d..c4a7a4f 100644 (file)
@@ -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 (file)
index 0000000..344311b
--- /dev/null
@@ -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 (file)
index 0000000..965801a
--- /dev/null
@@ -0,0 +1,4 @@
+
+proposal-229c.hs:6:3: error:
+    Illegal bang-pattern (use BangPatterns):
+    !x
index c02d2ee..27e6c70 100644 (file)
@@ -1,3 +1,3 @@
 
 strictnessDataCon_A.hs:1:27: error:
-    Strictness annotation cannot appear in this position.
+    Operator applied to too few arguments: !
index 88fc8d5..ad78bc9 100644 (file)
@@ -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)
index 2426e4c..2a83a36 100644 (file)
@@ -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 :: _ -> ()
index f010ce9..33f8ff7 100644 (file)
@@ -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)
index fce8b7d..0d7e44b 100644 (file)
@@ -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
index 62e5659..6ccc1f1 100644 (file)
@@ -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) }
index ff02835..7f74e48 100644 (file)
@@ -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
         
index 2d0f617..f40a71b 100644 (file)
@@ -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 |]
   ======>
index 3f0754a..b11a3bf 100644 (file)
@@ -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) |]
index 5d4b248..5c6e0f7 100644 (file)
@@ -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) |]
index d200f99..287793b 100644 (file)
@@ -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) |]
index 1b3559c..0c6b7f3 100644 (file)
@@ -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 '@'
index 4743613..6ed450c 100644 (file)
@@ -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 '@'
index 3a59ee7..544cf58 100644 (file)
@@ -1,2 +1,2 @@
 
-rnfail016a.hs:6:7: error: Pattern syntax in expression context: ~x
+rnfail016a.hs:6:7: error: parse error on input ‘~’
index 9c45a61..c1f4f43 100644 (file)
@@ -1,3 +1,3 @@
 
 rnfail051.hs:7:17: error:
-    Pattern syntax in expression context: _ -> putStrLn "_"
+    View pattern in expression context: _ -> putStrLn "_"
index 8e2530e..18c1bee 100644 (file)
@@ -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 |]
index 5b1fdbf..87bcb9b 100644 (file)
@@ -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 |]
index 730b1cf..8a1b5d8 100644 (file)
@@ -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 |]
index 8db3754..0ffa342 100644 (file)
@@ -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
index d5f7052..e71f287 100644 (file)
@@ -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;
index 6471421..d6c08b0 100644 (file)
@@ -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>]]
   ======>
index c294e74..3de6cb0 100644 (file)
@@ -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) }
index cc4946a..582190e 100644 (file)
@@ -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:
+    â\80¢ â\80\98static test2â\80\99 is not a valid C identifier
+    • When checking declaration:
+        foreign import prim safe "static test2" cmm_test2 :: Int# -> Int#
index 2491a8c..7c7b891 100644 (file)
@@ -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"))
index c960fe1..83e9434 100644 (file)
@@ -1,2 +1,2 @@
-T10810.hs:6:3-24: Splicing declarations
+T10810.hs:6:2-25: Splicing declarations
     [d| data Foo = (:!) |] ======> data Foo = (:!)
index 9c05b83..6f2b164 100644 (file)
@@ -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
index bbc57dd..e5f3690 100644 (file)
@@ -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 :: *
index e4f1cc6..0649997 100644 (file)
@@ -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 $$([|| \ _ -> () ||])
index aede24c..2b85643 100644 (file)
@@ -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
index 81c2eef..53b8550 100644 (file)
@@ -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’
index 1f34432..65f77d0 100644 (file)
@@ -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
index 6a68b3d..2cc0d11 100644 (file)
@@ -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.()
index 0ba1536..7398b32 100644 (file)
@@ -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
index 485dc64..debcc0b 100644 (file)
@@ -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 '[] [] ======> []
index 53700b5..7bb6587 100644 (file)
@@ -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
index 141b7a2..1d54574 100644 (file)
@@ -1 +1 @@
-T13856.hs:8:7-22: Splicing expression lamE [] [| 42 |] ======> 42
+T13856.hs:8:6-23: Splicing expression lamE [] [| 42 |] ======> 42
index 2850dae..420e3c6 100644 (file)
@@ -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
index 90150e2..5a8f57a 100644 (file)
@@ -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"))))
index 869cf6f..a8a82b1 100644 (file)
@@ -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 |]
   ======>
index debb18d..0a23fd1 100644 (file)
@@ -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)))) |]
index 034c9e3..524711c 100644 (file)
@@ -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 |]
index a2776b8..5361f69 100644 (file)
@@ -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 :: *"
index 09374f2..e5e54b9 100644 (file)
@@ -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
index e6d6325..4df1e66 100644 (file)
@@ -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 :: * -> *)
index 4e50186..4cf78ca 100644 (file)
@@ -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 '(:) = '(:)
index 2eb67f6..ba43e4d 100644 (file)
@@ -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)
index 3403d13..8db1dc4 100644 (file)
@@ -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)
index 49db9ed..0879fff 100644 (file)
@@ -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 |]
   ======>
index 99bfdfd..dee7e8c 100644 (file)
@@ -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) |]
   ======>
index aa3f6d9..7bfacf2 100644 (file)
@@ -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)
index 9631319..42f9806 100644 (file)
@@ -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
index 69a8c7b..01e508f 100644 (file)
@@ -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"
index ba7b91c..c7ccfd0 100644 (file)
@@ -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)
index 1177799..ba61ba3 100644 (file)
@@ -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)
index 7d9ef29..2eee5cc 100644 (file)
@@ -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 -> ()
index 8169d75..4c64d4a 100644 (file)
@@ -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
index 27132d6..ad077d8 100644 (file)
@@ -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 = '()
index 57a2db5..580a02a 100644 (file)
@@ -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
index 30dcd3a..3901f4d 100644 (file)
@@ -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
index 812fd58..c695164 100644 (file)
@@ -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
index 8a41fd1..bf9c20b 100644 (file)
@@ -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.
index 8264967..fcacf77 100644 (file)
@@ -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 |]
index d4b98c9..5a5222e 100644 (file)
@@ -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 |])
index 8309912..597736c 100644 (file)
@@ -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 |]))
index 38475cc..baa5e75 100644 (file)
@@ -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)
index 57ba872..2832aee 100644 (file)
@@ -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 |]))
index 90884a0..43d7ac4 100644 (file)
@@ -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)
index ec98c5f..feee281 100644 (file)
@@ -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
index 47410ec..54285bd 100644 (file)
@@ -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
index a2501a4..85724eb 100644 (file)
@@ -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")
index c4ad33a..b4551f7 100644 (file)
@@ -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
index cc73040..f7b9f4b 100644 (file)
@@ -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 |]
index 0e897cc..aba3925 100644 (file)
@@ -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
index 0d9a382..9c7f0ba 100644 (file)
@@ -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: 
index d68be6d..a9b8bed 100644 (file)
@@ -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)
 
index b88b10f..7ecaf24 100644 (file)
@@ -1,4 +1,4 @@
-T3319.hs:8:3-93: Splicing declarations
+T3319.hs:8:2-94: Splicing declarations
     return
       [ForeignD
          (ImportF
index 3c51176..a9bcdbe 100644 (file)
@@ -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")])
index 4f63ef1..b0ea19d 100644 (file)
@@ -1,2 +1,2 @@
-T3600.hs:5:3-6: Splicing declarations
+T3600.hs:5:2-7: Splicing declarations
     test ======> myFunction = (testFun1 [], testFun2 [], testFun2 "x")
index 2b4a76a..3c4a707 100644 (file)
@@ -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)
index d87bfc1..f7ed0e1 100644 (file)
@@ -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
index 30797a8..04b4d25 100644 (file)
@@ -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
index 19c962a..f595e55 100644 (file)
@@ -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
index cc1df54..6561e08 100644 (file)
@@ -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))
index 7000204..5511ec6 100644 (file)
@@ -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 |]
index 3564b8c..4be0632 100644 (file)
@@ -1,4 +1,4 @@
-T5700.hs:8:3-9: Splicing declarations
+T5700.hs:8:2-10: Splicing declarations
     mkC ''D
   ======>
     instance C D where
index 79e9f92..95af718 100644 (file)
@@ -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
index aa87a41..04db65b 100644 (file)
@@ -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
index d48c225..c8164cd 100644 (file)
@@ -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)
index f4e9568..7d815f2 100644 (file)
@@ -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"))
index 2e612c7..3bd89f1 100644 (file)
@@ -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
index b905fe8..c141bfc 100644 (file)
@@ -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
index 07d17c9..1681b45 100644 (file)
@@ -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
index f94de68..7aee71e 100644 (file)
@@ -1,3 +1,3 @@
 
-T7477.hs:10:4: Warning:
+T7477.hs:10:2: warning:
     type instance T7477.F GHC.Types.Int = GHC.Types.Bool
index 3ffe123..5964a2f 100644 (file)
@@ -1,4 +1,4 @@
 
-T7484.hs:7:4:
+T7484.hs:7:2: error:
     Illegal variable name: ‘a ’
     When splicing a TH declaration: a  = 5
index baaf04f..d807c37 100644 (file)
@@ -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
index ca8b8f2..b9807f0 100644 (file)
@@ -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"))
index 82b6116..9e69b8e 100644 (file)
@@ -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))
index 1a0fb75..b6ff05a 100644 (file)
@@ -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)
index 0dcc7b0..6286ee2 100644 (file)
@@ -1,2 +1,2 @@
--- T8624.hs:(7,3)-(8,43): Splicing declarations
+-- T8624.hs:(7,2)-(8,44): Splicing declarations
 data THDec = THDec
index b980c00..d3cde8b 100644 (file)
@@ -1,3 +1,3 @@
 
-T8759.hs:9:4: warning:
+T8759.hs:9:2: warning:
     PatSynI T8759.P (ForallT [] [] (ForallT [] [] (TupleT 0)))
index 96e5d8a..4dbbfe6 100644 (file)
@@ -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
index 7b5f400..00181fa 100644 (file)
@@ -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 [])
index 3acb218..07b6584 100644 (file)
@@ -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
index 495fb1c..d75a626 100644 (file)
@@ -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
index fde888f..d3eba9a 100644 (file)
@@ -1,3 +1,3 @@
 
-TH_PromotedList.hs:11:3: warning:
+TH_PromotedList.hs:11:2: warning:
     '(:) GHC.Types.Int ('(:) GHC.Types.Bool '[])
index 92792a3..29b60f0 100644 (file)
@@ -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)
index eb40290..920e424 100644 (file)
@@ -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)
index a0b29a1..ae842d4 100644 (file)
@@ -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)
index 952b331..2b66585 100644 (file)
@@ -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’
index e6f6963..a89ad11 100644 (file)
@@ -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) |] })
index 0d07db8..4f5d278 100644 (file)
@@ -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
index 717fb0e..c79af94 100644 (file)
@@ -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
index e08af85..c44ba63 100644 (file)
@@ -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
index 6354861..69c854e 100644 (file)
@@ -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 [] })
index 3ccc9e1..582928c 100644 (file)
@@ -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))
index b73acbb..6df144d 100644 (file)
@@ -1,2 +1,2 @@
 
-TH_fail.hs:7:4: Code not written yet...
+TH_fail.hs:7:2: error: Code not written yet...
index dae9945..df09310 100644 (file)
@@ -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 ()
index 4afc38a..28440eb 100644 (file)
@@ -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 ()
index 8f2d592..2c4c51c 100644 (file)
@@ -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
index 8232481..56acdfd 100644 (file)
@@ -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
index f93aa55..faa2a9e 100644 (file)
@@ -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
index fe3bf67..a83ead7 100644 (file)
@@ -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"
index 9124c2d..0e8f6b6 100644 (file)
@@ -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
index 1156ade..0baf21c 100644 (file)
@@ -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 |]
index c92ee71..24bfb76 100644 (file)
@@ -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)]
index 5d5a4f2..50af621 100644 (file)
@@ -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"))
index 9e6fb50..77ae873 100644 (file)
@@ -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’
index 4a5577f..50d56a0 100644 (file)
@@ -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))
index 08a319c..af557c4 100644 (file)
@@ -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: !
index dd03a0a..2b764ca 100644 (file)
@@ -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
index 4d7cb38..d0ca04a 100644 (file)
@@ -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’
index d84d5a5..b6359cb 160000 (submodule)
@@ -1 +1 @@
-Subproject commit d84d5a572b7ddaf471eccb39da620807ef3591da
+Subproject commit b6359cba90e5edfe549f933beeb00a13f01567b2