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