[Git][ghc/ghc][master] Rename parser Error and Warning types
Marge Bot
gitlab at gitlab.haskell.org
Fri Dec 18 10:52:40 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d66b4bcd by Alfredo Di Napoli at 2020-12-18T05:52:25-05:00
Rename parser Error and Warning types
This commit renames parser's Error and Warning types (and their
constructors) to have a 'Ps' prefix, so that this would play nicely
when more errors and warnings for other phases of the pipeline will
be added. This will make more explicit which is the particular type
of error and warning we are dealing with, and will be more informative
for users to see in the generated Haddock.
- - - - -
11 changed files:
- compiler/GHC/Cmm/Lexer.x
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Parser/Monad.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
Changes:
=====================================
compiler/GHC/Cmm/Lexer.x
=====================================
@@ -326,7 +326,7 @@ lexToken = do
AlexEOF -> do let span = mkPsSpan loc1 loc1
liftP (setLastToken span 0)
return (L span CmmT_EOF)
- AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (Error ErrCmmLexer [])
+ AlexError (loc2,_) -> liftP $ failLocMsgP (psRealLoc loc1) (psRealLoc loc2) (PsError PsErrCmmLexer [])
AlexSkip inp2 _ -> do
setInput inp2
lexToken
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -919,7 +919,7 @@ getLit _ = panic "invalid literal" -- TODO messy failure
nameToMachOp :: FastString -> PD (Width -> MachOp)
nameToMachOp name =
case lookupUFM machOps name of
- Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) []
+ Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) []
Just m -> return m
exprOp :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse CmmExpr)
@@ -1081,12 +1081,12 @@ parseSafety :: String -> PD Safety
parseSafety "safe" = return PlaySafe
parseSafety "unsafe" = return PlayRisky
parseSafety "interruptible" = return PlayInterruptible
-parseSafety str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedSafety str)) []
+parseSafety str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedSafety str)) []
parseCmmHint :: String -> PD ForeignHint
parseCmmHint "ptr" = return AddrHint
parseCmmHint "signed" = return SignedHint
-parseCmmHint str = failMsgPD $ Error (ErrCmmParser (CmmUnrecognisedHint str)) []
+parseCmmHint str = failMsgPD $ PsError (PsErrCmmParser (CmmUnrecognisedHint str)) []
-- labels are always pointers, so we might as well infer the hint
inferCmmHint :: CmmExpr -> ForeignHint
@@ -1113,7 +1113,7 @@ happyError = PD $ \_ _ s -> unP srcParseFail s
stmtMacro :: FastString -> [CmmParse CmmExpr] -> PD (CmmParse ())
stmtMacro fun args_code = do
case lookupUFM stmtMacros fun of
- Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownMacro fun)) []
+ Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownMacro fun)) []
Just fcode -> return $ do
args <- sequence args_code
code (fcode args)
@@ -1216,7 +1216,7 @@ foreignCall conv_string results_code expr_code args_code safety ret
= do conv <- case conv_string of
"C" -> return CCallConv
"stdcall" -> return StdCallConv
- _ -> failMsgPD $ Error (ErrCmmParser (CmmUnknownCConv conv_string)) []
+ _ -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownCConv conv_string)) []
return $ do
platform <- getPlatform
results <- sequence results_code
@@ -1294,7 +1294,7 @@ primCall results_code name args_code
= do
platform <- PD.getPlatform
case lookupUFM (callishMachOps platform) name of
- Nothing -> failMsgPD $ Error (ErrCmmParser (CmmUnknownPrimitive name)) []
+ Nothing -> failMsgPD $ PsError (PsErrCmmParser (CmmUnknownPrimitive name)) []
Just f -> return $ do
results <- sequence results_code
args <- sequence args_code
@@ -1448,7 +1448,7 @@ initEnv profile = listToUFM [
]
where platform = profilePlatform profile
-parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag Warning, Bag Error, Maybe CmmGroup)
+parseCmmFile :: DynFlags -> HomeUnit -> FilePath -> IO (Bag PsWarning, Bag PsError, Maybe CmmGroup)
parseCmmFile dflags home_unit filename = do
buf <- hGetStringBuffer filename
let
=====================================
compiler/GHC/Cmm/Parser/Monad.hs
=====================================
@@ -47,7 +47,7 @@ instance Monad PD where
liftP :: P a -> PD a
liftP (P f) = PD $ \_ _ s -> f s
-failMsgPD :: (SrcSpan -> Error) -> PD a
+failMsgPD :: (SrcSpan -> PsError) -> PD a
failMsgPD = liftP . failMsgP
returnPD :: a -> PD a
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -285,7 +285,7 @@ handleWarnings = do
-- | log warning in the monad, and if there are errors then
-- throw a SourceError exception.
-logWarningsReportErrors :: (Bag Warning, Bag Error) -> Hsc ()
+logWarningsReportErrors :: (Bag PsWarning, Bag PsError) -> Hsc ()
logWarningsReportErrors (warnings,errors) = do
let warns = fmap pprWarning warnings
errs = fmap pprError errors
@@ -294,7 +294,7 @@ logWarningsReportErrors (warnings,errors) = do
-- | Log warnings and throw errors, assuming the messages
-- contain at least one error (e.g. coming from PFailed)
-handleWarningsThrowErrors :: (Bag Warning, Bag Error) -> Hsc a
+handleWarningsThrowErrors :: (Bag PsWarning, Bag PsError) -> Hsc a
handleWarningsThrowErrors (warnings, errors) = do
let warns = fmap pprWarning warnings
errs = fmap pprError errors
=====================================
compiler/GHC/Parser.y
=====================================
@@ -788,7 +788,7 @@ HYPHEN :: { [AddAnn] }
| PREFIX_MINUS { [mj AnnMinus $1 ] }
| VARSYM {% if (getVARSYM $1 == fsLit "-")
then return [mj AnnMinus $1]
- else do { addError $ Error ErrExpectedHyphen [] (getLoc $1)
+ else do { addError $ PsError PsErrExpectedHyphen [] (getLoc $1)
; return [] } }
@@ -1087,7 +1087,7 @@ maybe_safe :: { ([AddAnn],Bool) }
maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
: STRING {% do { let { pkgFS = getSTRING $1 }
; unless (looksLikePackageName (unpackFS pkgFS)) $
- addError $ Error (ErrInvalidPackageName pkgFS) [] (getLoc $1)
+ addError $ PsError (PsErrInvalidPackageName pkgFS) [] (getLoc $1)
; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
| {- empty -} { ([],Nothing) }
@@ -1788,7 +1788,7 @@ rule_activation_marker :: { [AddAnn] }
: PREFIX_TILDE { [mj AnnTilde $1] }
| VARSYM {% if (getVARSYM $1 == fsLit "~")
then return [mj AnnTilde $1]
- else do { addError $ Error ErrInvalidRuleActivationMarker [] (getLoc $1)
+ else do { addError $ PsError PsErrInvalidRuleActivationMarker [] (getLoc $1)
; return [] } }
rule_explicit_activation :: { ([AddAnn]
@@ -3847,7 +3847,7 @@ getSCC :: Located Token -> P FastString
getSCC lt = do let s = getSTRING lt
-- We probably actually want to be more restrictive than this
if ' ' `elem` unpackFS s
- then addFatalError $ Error ErrSpaceInSCC [] (getLoc lt)
+ then addFatalError $ PsError PsErrSpaceInSCC [] (getLoc lt)
else return s
-- Utilities for combining source spans
@@ -3937,7 +3937,7 @@ fileSrcSpan = do
hintLinear :: MonadP m => SrcSpan -> m ()
hintLinear span = do
linearEnabled <- getBit LinearTypesBit
- unless linearEnabled $ addError $ Error ErrLinearFunction [] span
+ unless linearEnabled $ addError $ PsError PsErrLinearFunction [] span
-- Does this look like (a %m)?
looksLikeMult :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> Bool
@@ -3956,14 +3956,14 @@ looksLikeMult ty1 l_op ty2
hintMultiWayIf :: SrcSpan -> P ()
hintMultiWayIf span = do
mwiEnabled <- getBit MultiWayIfBit
- unless mwiEnabled $ addError $ Error ErrMultiWayIf [] span
+ unless mwiEnabled $ addError $ PsError PsErrMultiWayIf [] span
-- Hint about explicit-forall
hintExplicitForall :: Located Token -> P ()
hintExplicitForall tok = do
forall <- getBit ExplicitForallBit
rulePrag <- getBit InRulePragBit
- unless (forall || rulePrag) $ addError $ Error (ErrExplicitForall (isUnicode tok)) [] (getLoc tok)
+ unless (forall || rulePrag) $ addError $ PsError (PsErrExplicitForall (isUnicode tok)) [] (getLoc tok)
-- Hint about qualified-do
hintQualifiedDo :: Located Token -> P ()
@@ -3971,7 +3971,7 @@ hintQualifiedDo tok = do
qualifiedDo <- getBit QualifiedDoBit
case maybeQDoDoc of
Just qdoDoc | not qualifiedDo ->
- addError $ Error (ErrIllegalQualifiedDo qdoDoc) [] (getLoc tok)
+ addError $ PsError (PsErrIllegalQualifiedDo qdoDoc) [] (getLoc tok)
_ -> return ()
where
maybeQDoDoc = case unLoc tok of
@@ -3985,7 +3985,7 @@ hintQualifiedDo tok = do
reportEmptyDoubleQuotes :: SrcSpan -> P a
reportEmptyDoubleQuotes span = do
thQuotes <- getBit ThQuotesBit
- addFatalError $ Error (ErrEmptyDoubleQuotes thQuotes) [] span
+ addFatalError $ PsError (PsErrEmptyDoubleQuotes thQuotes) [] span
{-
%************************************************************************
=====================================
compiler/GHC/Parser/Errors.hs
=====================================
@@ -1,11 +1,11 @@
module GHC.Parser.Errors
- ( Warning(..)
+ ( PsWarning(..)
, TransLayoutReason(..)
, OperatorWhitespaceSymbol(..)
, OperatorWhitespaceOccurrence(..)
, NumUnderscoreReason(..)
- , Error(..)
- , ErrorDesc(..)
+ , PsError(..)
+ , PsErrorDesc(..)
, LexErr(..)
, CmmParserError(..)
, LexErrKind(..)
@@ -30,37 +30,38 @@ import GHC.Utils.Outputable (SDoc)
import GHC.Data.FastString
import GHC.Unit.Module.Name
-data Warning
+-- | A warning that might arise during parsing.
+data PsWarning
-- | Warn when tabulations are found
- = WarnTab
+ = PsWarnTab
{ tabFirst :: !SrcSpan -- ^ First occurence of a tab
, tabCount :: !Word -- ^ Number of other occurences
}
- | WarnTransitionalLayout !SrcSpan !TransLayoutReason
+ | PsWarnTransitionalLayout !SrcSpan !TransLayoutReason
-- ^ Transitional layout warnings
- | WarnUnrecognisedPragma !SrcSpan
+ | PsWarnUnrecognisedPragma !SrcSpan
-- ^ Unrecognised pragma
- | WarnHaddockInvalidPos !SrcSpan
+ | PsWarnHaddockInvalidPos !SrcSpan
-- ^ Invalid Haddock comment position
- | WarnHaddockIgnoreMulti !SrcSpan
+ | PsWarnHaddockIgnoreMulti !SrcSpan
-- ^ Multiple Haddock comment for the same entity
- | WarnStarBinder !SrcSpan
+ | PsWarnStarBinder !SrcSpan
-- ^ Found binding occurence of "*" while StarIsType is enabled
- | WarnStarIsType !SrcSpan
+ | PsWarnStarIsType !SrcSpan
-- ^ Using "*" for "Type" without StarIsType enabled
- | WarnImportPreQualified !SrcSpan
+ | PsWarnImportPreQualified !SrcSpan
-- ^ Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled
- | WarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol
- | WarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence
+ | PsWarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol
+ | PsWarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence
-- | The operator symbol in the 'WarnOperatorWhitespaceExtConflict' warning.
data OperatorWhitespaceSymbol
@@ -78,146 +79,146 @@ data TransLayoutReason
= TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
| TransLayout_Pipe -- ^ "`|' at the same depth as implicit layout block")
-data Error = Error
- { errDesc :: !ErrorDesc -- ^ Error description
+data PsError = PsError
+ { errDesc :: !PsErrorDesc -- ^ Error description
, errHints :: ![Hint] -- ^ Hints
, errLoc :: !SrcSpan -- ^ Error position
}
-data ErrorDesc
- = ErrLambdaCase
+data PsErrorDesc
+ = PsErrLambdaCase
-- ^ LambdaCase syntax used without the extension enabled
- | ErrNumUnderscores !NumUnderscoreReason
+ | PsErrNumUnderscores !NumUnderscoreReason
-- ^ Underscores in literals without the extension enabled
- | ErrPrimStringInvalidChar
+ | PsErrPrimStringInvalidChar
-- ^ Invalid character in primitive string
- | ErrMissingBlock
+ | PsErrMissingBlock
-- ^ Missing block
- | ErrLexer !LexErr !LexErrKind
+ | PsErrLexer !LexErr !LexErrKind
-- ^ Lexer error
- | ErrSuffixAT
+ | PsErrSuffixAT
-- ^ Suffix occurence of `@`
- | ErrParse !String
+ | PsErrParse !String
-- ^ Parse errors
- | ErrCmmLexer
+ | PsErrCmmLexer
-- ^ Cmm lexer error
- | ErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs))
+ | PsErrUnsupportedBoxedSumExpr !(SumOrTuple (HsExpr GhcPs))
-- ^ Unsupported boxed sum in expression
- | ErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs))
+ | PsErrUnsupportedBoxedSumPat !(SumOrTuple (PatBuilder GhcPs))
-- ^ Unsupported boxed sum in pattern
- | ErrUnexpectedQualifiedConstructor !RdrName
+ | PsErrUnexpectedQualifiedConstructor !RdrName
-- ^ Unexpected qualified constructor
- | ErrTupleSectionInPat
+ | PsErrTupleSectionInPat
-- ^ Tuple section in pattern context
- | ErrIllegalBangPattern !(Pat GhcPs)
+ | PsErrIllegalBangPattern !(Pat GhcPs)
-- ^ Bang-pattern without BangPattterns enabled
- | ErrOpFewArgs !StarIsType !RdrName
+ | PsErrOpFewArgs !StarIsType !RdrName
-- ^ Operator applied to too few arguments
- | ErrImportQualifiedTwice
+ | PsErrImportQualifiedTwice
-- ^ Import: multiple occurrences of 'qualified'
- | ErrImportPostQualified
+ | PsErrImportPostQualified
-- ^ Post qualified import without 'ImportQualifiedPost'
- | ErrIllegalExplicitNamespace
+ | PsErrIllegalExplicitNamespace
-- ^ Explicit namespace keyword without 'ExplicitNamespaces'
- | ErrVarForTyCon !RdrName
+ | PsErrVarForTyCon !RdrName
-- ^ Expecting a type constructor but found a variable
- | ErrIllegalPatSynExport
+ | PsErrIllegalPatSynExport
-- ^ Illegal export form allowed by PatternSynonyms
- | ErrMalformedEntityString
+ | PsErrMalformedEntityString
-- ^ Malformed entity string
- | ErrDotsInRecordUpdate
+ | PsErrDotsInRecordUpdate
-- ^ Dots used in record update
- | ErrPrecedenceOutOfRange !Int
+ | PsErrPrecedenceOutOfRange !Int
-- ^ Precedence out of range
- | ErrInvalidDataCon !(HsType GhcPs)
+ | PsErrInvalidDataCon !(HsType GhcPs)
-- ^ Cannot parse data constructor in a data/newtype declaration
- | ErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs)
+ | PsErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs)
-- ^ Cannot parse data constructor in a data/newtype declaration
- | ErrUnpackDataCon
+ | PsErrUnpackDataCon
-- ^ UNPACK applied to a data constructor
- | ErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs)
+ | PsErrUnexpectedKindAppInDataCon !DataConBuilder !(HsType GhcPs)
-- ^ Unexpected kind application in data/newtype declaration
- | ErrInvalidRecordCon !(PatBuilder GhcPs)
+ | PsErrInvalidRecordCon !(PatBuilder GhcPs)
-- ^ Not a record constructor
- | ErrIllegalUnboxedStringInPat !(HsLit GhcPs)
+ | PsErrIllegalUnboxedStringInPat !(HsLit GhcPs)
-- ^ Illegal unboxed string literal in pattern
- | ErrDoNotationInPat
+ | PsErrDoNotationInPat
-- ^ Do-notation in pattern
- | ErrIfTheElseInPat
+ | PsErrIfTheElseInPat
-- ^ If-then-else syntax in pattern
- | ErrLambdaCaseInPat
+ | PsErrLambdaCaseInPat
-- ^ Lambda-case in pattern
- | ErrCaseInPat
+ | PsErrCaseInPat
-- ^ case..of in pattern
- | ErrLetInPat
+ | PsErrLetInPat
-- ^ let-syntax in pattern
- | ErrLambdaInPat
+ | PsErrLambdaInPat
-- ^ Lambda-syntax in pattern
- | ErrArrowExprInPat !(HsExpr GhcPs)
+ | PsErrArrowExprInPat !(HsExpr GhcPs)
-- ^ Arrow expression-syntax in pattern
- | ErrArrowCmdInPat !(HsCmd GhcPs)
+ | PsErrArrowCmdInPat !(HsCmd GhcPs)
-- ^ Arrow command-syntax in pattern
- | ErrArrowCmdInExpr !(HsCmd GhcPs)
+ | PsErrArrowCmdInExpr !(HsCmd GhcPs)
-- ^ Arrow command-syntax in expression
- | ErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs)
+ | PsErrViewPatInExpr !(LHsExpr GhcPs) !(LHsExpr GhcPs)
-- ^ View-pattern in expression
- | ErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs)
+ | PsErrTypeAppWithoutSpace !RdrName !(LHsExpr GhcPs)
-- ^ Type-application without space before '@'
- | ErrLazyPatWithoutSpace !(LHsExpr GhcPs)
+ | PsErrLazyPatWithoutSpace !(LHsExpr GhcPs)
-- ^ Lazy-pattern ('~') without space after it
- | ErrBangPatWithoutSpace !(LHsExpr GhcPs)
+ | PsErrBangPatWithoutSpace !(LHsExpr GhcPs)
-- ^ Bang-pattern ('!') without space after it
- | ErrUnallowedPragma !(HsPragE GhcPs)
+ | PsErrUnallowedPragma !(HsPragE GhcPs)
-- ^ Pragma not allowed in this position
- | ErrQualifiedDoInCmd !ModuleName
+ | PsErrQualifiedDoInCmd !ModuleName
-- ^ Qualified do block in command
- | ErrInvalidInfixHole
+ | PsErrInvalidInfixHole
-- ^ Invalid infix hole, expected an infix operator
- | ErrSemiColonsInCondExpr
+ | PsErrSemiColonsInCondExpr
-- ^ Unexpected semi-colons in conditional expression
!(HsExpr GhcPs) -- ^ conditional expr
!Bool -- ^ "then" semi-colon?
@@ -225,7 +226,7 @@ data ErrorDesc
!Bool -- ^ "else" semi-colon?
!(HsExpr GhcPs) -- ^ "else" expr
- | ErrSemiColonsInCondCmd
+ | PsErrSemiColonsInCondCmd
-- ^ Unexpected semi-colons in conditional command
!(HsExpr GhcPs) -- ^ conditional expr
!Bool -- ^ "then" semi-colon?
@@ -233,143 +234,143 @@ data ErrorDesc
!Bool -- ^ "else" semi-colon?
!(HsCmd GhcPs) -- ^ "else" expr
- | ErrAtInPatPos
+ | PsErrAtInPatPos
-- ^ @-operator in a pattern position
- | ErrLambdaCmdInFunAppCmd !(LHsCmd GhcPs)
+ | PsErrLambdaCmdInFunAppCmd !(LHsCmd GhcPs)
-- ^ Unexpected lambda command in function application
- | ErrCaseCmdInFunAppCmd !(LHsCmd GhcPs)
+ | PsErrCaseCmdInFunAppCmd !(LHsCmd GhcPs)
-- ^ Unexpected case command in function application
- | ErrIfCmdInFunAppCmd !(LHsCmd GhcPs)
+ | PsErrIfCmdInFunAppCmd !(LHsCmd GhcPs)
-- ^ Unexpected if command in function application
- | ErrLetCmdInFunAppCmd !(LHsCmd GhcPs)
+ | PsErrLetCmdInFunAppCmd !(LHsCmd GhcPs)
-- ^ Unexpected let command in function application
- | ErrDoCmdInFunAppCmd !(LHsCmd GhcPs)
+ | PsErrDoCmdInFunAppCmd !(LHsCmd GhcPs)
-- ^ Unexpected do command in function application
- | ErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
+ | PsErrDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
-- ^ Unexpected do block in function application
- | ErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
+ | PsErrMDoInFunAppExpr !(Maybe ModuleName) !(LHsExpr GhcPs)
-- ^ Unexpected mdo block in function application
- | ErrLambdaInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrLambdaInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected lambda expression in function application
- | ErrCaseInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrCaseInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected case expression in function application
- | ErrLambdaCaseInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrLambdaCaseInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected lambda-case expression in function application
- | ErrLetInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrLetInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected let expression in function application
- | ErrIfInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrIfInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected if expression in function application
- | ErrProcInFunAppExpr !(LHsExpr GhcPs)
+ | PsErrProcInFunAppExpr !(LHsExpr GhcPs)
-- ^ Unexpected proc expression in function application
- | ErrMalformedTyOrClDecl !(LHsType GhcPs)
+ | PsErrMalformedTyOrClDecl !(LHsType GhcPs)
-- ^ Malformed head of type or class declaration
- | ErrIllegalWhereInDataDecl
+ | PsErrIllegalWhereInDataDecl
-- ^ Illegal 'where' keyword in data declaration
- | ErrIllegalDataTypeContext !(LHsContext GhcPs)
+ | PsErrIllegalDataTypeContext !(LHsContext GhcPs)
-- ^ Illegal datatyp context
- | ErrParseErrorOnInput !OccName
+ | PsErrParseErrorOnInput !OccName
-- ^ Parse error on input
- | ErrMalformedDecl !SDoc !RdrName
+ | PsErrMalformedDecl !SDoc !RdrName
-- ^ Malformed ... declaration for ...
- | ErrUnexpectedTypeAppInDecl !(LHsType GhcPs) !SDoc !RdrName
+ | PsErrUnexpectedTypeAppInDecl !(LHsType GhcPs) !SDoc !RdrName
-- ^ Unexpected type application in a declaration
- | ErrNotADataCon !RdrName
+ | PsErrNotADataCon !RdrName
-- ^ Not a data constructor
- | ErrRecordSyntaxInPatSynDecl !(LPat GhcPs)
+ | PsErrRecordSyntaxInPatSynDecl !(LPat GhcPs)
-- ^ Record syntax used in pattern synonym declaration
- | ErrEmptyWhereInPatSynDecl !RdrName
+ | PsErrEmptyWhereInPatSynDecl !RdrName
-- ^ Empty 'where' clause in pattern-synonym declaration
- | ErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
+ | PsErrInvalidWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
-- ^ Invalid binding name in 'where' clause of pattern-synonym declaration
- | ErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
+ | PsErrNoSingleWhereBindInPatSynDecl !RdrName !(HsDecl GhcPs)
-- ^ Multiple bindings in 'where' clause of pattern-synonym declaration
- | ErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs)
+ | PsErrDeclSpliceNotAtTopLevel !(SpliceDecl GhcPs)
-- ^ Declaration splice not a top-level
- | ErrInferredTypeVarNotAllowed
+ | PsErrInferredTypeVarNotAllowed
-- ^ Inferred type variables not allowed here
- | ErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs]
+ | PsErrMultipleNamesInStandaloneKindSignature [LIdP GhcPs]
-- ^ Multiple names in standalone kind signatures
- | ErrIllegalImportBundleForm
+ | PsErrIllegalImportBundleForm
-- ^ Illegal import bundle form
- | ErrIllegalRoleName !FastString [Role]
+ | PsErrIllegalRoleName !FastString [Role]
-- ^ Illegal role name
- | ErrInvalidTypeSignature !(LHsExpr GhcPs)
+ | PsErrInvalidTypeSignature !(LHsExpr GhcPs)
-- ^ Invalid type signature
- | ErrUnexpectedTypeInDecl !(LHsType GhcPs) !SDoc !RdrName [LHsTypeArg GhcPs] !SDoc
+ | PsErrUnexpectedTypeInDecl !(LHsType GhcPs) !SDoc !RdrName [LHsTypeArg GhcPs] !SDoc
-- ^ Unexpected type in declaration
- | ErrExpectedHyphen
+ | PsErrExpectedHyphen
-- ^ Expected a hyphen
- | ErrSpaceInSCC
+ | PsErrSpaceInSCC
-- ^ Found a space in a SCC
- | ErrEmptyDoubleQuotes !Bool-- Is TH on?
+ | PsErrEmptyDoubleQuotes !Bool-- Is TH on?
-- ^ Found two single quotes
- | ErrInvalidPackageName !FastString
+ | PsErrInvalidPackageName !FastString
-- ^ Invalid package name
- | ErrInvalidRuleActivationMarker
+ | PsErrInvalidRuleActivationMarker
-- ^ Invalid rule activation marker
- | ErrLinearFunction
+ | PsErrLinearFunction
-- ^ Linear function found but LinearTypes not enabled
- | ErrMultiWayIf
+ | PsErrMultiWayIf
-- ^ Multi-way if-expression found but MultiWayIf not enabled
- | ErrExplicitForall !Bool -- is Unicode forall?
+ | PsErrExplicitForall !Bool -- is Unicode forall?
-- ^ Explicit forall found but no extension allowing it is enabled
- | ErrIllegalQualifiedDo !SDoc
+ | PsErrIllegalQualifiedDo !SDoc
-- ^ Found qualified-do without QualifiedDo enabled
- | ErrCmmParser !CmmParserError
+ | PsErrCmmParser !CmmParserError
-- ^ Cmm parser error
- | ErrIllegalTraditionalRecordSyntax !SDoc
+ | PsErrIllegalTraditionalRecordSyntax !SDoc
-- ^ Illegal traditional record syntax
--
-- TODO: distinguish errors without using SDoc
- | ErrParseErrorInCmd !SDoc
+ | PsErrParseErrorInCmd !SDoc
-- ^ Parse error in command
--
-- TODO: distinguish errors without using SDoc
- | ErrParseErrorInPat !SDoc
+ | PsErrParseErrorInPat !SDoc
-- ^ Parse error in pattern
--
-- TODO: distinguish errors without using SDoc
=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -44,9 +44,9 @@ mkParserWarn flag span doc = ErrMsg
, errMsgReason = Reason flag
}
-pprWarning :: Warning -> ErrMsg
+pprWarning :: PsWarning -> ErrMsg
pprWarning = \case
- WarnTab loc tc
+ PsWarnTab loc tc
-> mkParserWarn Opt_WarnTabs loc $
text "Tab character found here"
<> (if tc == 1
@@ -55,7 +55,7 @@ pprWarning = \case
<> text "."
$+$ text "Please use spaces instead."
- WarnTransitionalLayout loc reason
+ PsWarnTransitionalLayout loc reason
-> mkParserWarn Opt_WarnAlternativeLayoutRuleTransitional loc $
text "transitional layout will not be accepted in the future:"
$$ text (case reason of
@@ -63,20 +63,20 @@ pprWarning = \case
TransLayout_Pipe -> "`|' at the same depth as implicit layout block"
)
- WarnUnrecognisedPragma loc
+ PsWarnUnrecognisedPragma loc
-> mkParserWarn Opt_WarnUnrecognisedPragmas loc $
text "Unrecognised pragma"
- WarnHaddockInvalidPos loc
+ PsWarnHaddockInvalidPos loc
-> mkParserWarn Opt_WarnInvalidHaddock loc $
text "A Haddock comment cannot appear in this position and will be ignored."
- WarnHaddockIgnoreMulti loc
+ PsWarnHaddockIgnoreMulti loc
-> mkParserWarn Opt_WarnInvalidHaddock loc $
text "Multiple Haddock comments for a single entity are not allowed." $$
text "The extraneous comment will be ignored."
- WarnStarBinder loc
+ PsWarnStarBinder loc
-> mkParserWarn Opt_WarnStarBinder loc $
text "Found binding occurrence of" <+> quotes (text "*")
<+> text "yet StarIsType is enabled."
@@ -84,7 +84,7 @@ pprWarning = \case
<+> text "modules with StarIsType,"
$$ text " including the definition module, you must qualify it."
- WarnStarIsType loc
+ PsWarnStarIsType loc
-> mkParserWarn Opt_WarnStarIsType loc $
text "Using" <+> quotes (text "*")
<+> text "(or its Unicode variant) to mean"
@@ -94,7 +94,7 @@ pprWarning = \case
$$ text "Suggested fix: use" <+> quotes (text "Type")
<+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
- WarnImportPreQualified loc
+ PsWarnImportPreQualified loc
-> mkParserWarn Opt_WarnPrepositiveQualifiedModule loc $
text "Found" <+> quotes (text "qualified")
<+> text "in prepositive position"
@@ -102,7 +102,7 @@ pprWarning = \case
<+> text "after the module name instead."
$$ text "To allow this, enable language extension 'ImportQualifiedPost'"
- WarnOperatorWhitespaceExtConflict loc sym
+ PsWarnOperatorWhitespaceExtConflict loc sym
-> mkParserWarn Opt_WarnOperatorWhitespaceExtConflict loc $
let mk_prefix_msg operator_symbol extension_name syntax_meaning =
text "The prefix use of a" <+> quotes (text operator_symbol)
@@ -117,7 +117,7 @@ pprWarning = \case
OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "$$" "TemplateHaskell" "a typed splice"
- WarnOperatorWhitespace loc sym occ_type
+ PsWarnOperatorWhitespace loc sym occ_type
-> mkParserWarn Opt_WarnOperatorWhitespace loc $
let mk_msg occ_type_str =
text "The" <+> text occ_type_str <+> text "use of a" <+> quotes (ftext sym)
@@ -130,27 +130,27 @@ pprWarning = \case
OperatorWhitespaceOccurrence_Suffix -> mk_msg "suffix"
OperatorWhitespaceOccurrence_TightInfix -> mk_msg "tight infix"
-pprError :: Error -> ErrMsg
+pprError :: PsError -> ErrMsg
pprError err = mkParserErr (errLoc err) $ vcat
(pp_err (errDesc err) : map pp_hint (errHints err))
-pp_err :: ErrorDesc -> SDoc
+pp_err :: PsErrorDesc -> SDoc
pp_err = \case
- ErrLambdaCase
+ PsErrLambdaCase
-> text "Illegal lambda-case (use LambdaCase)"
- ErrNumUnderscores reason
+ PsErrNumUnderscores reason
-> text $ case reason of
NumUnderscore_Integral -> "Use NumericUnderscores to allow underscores in integer literals"
NumUnderscore_Float -> "Use NumericUnderscores to allow underscores in floating literals"
- ErrPrimStringInvalidChar
+ PsErrPrimStringInvalidChar
-> text "primitive string literal must contain only characters <= \'\\xFF\'"
- ErrMissingBlock
+ PsErrMissingBlock
-> text "Missing block"
- ErrLexer err kind
+ PsErrLexer err kind
-> hcat
[ text $ case err of
LexError -> "lexical error"
@@ -170,53 +170,53 @@ pp_err = \case
LexErrKind_Char c -> " at character " ++ show c
]
- ErrSuffixAT
+ PsErrSuffixAT
-> text "Suffix occurrence of @. For an as-pattern, remove the leading whitespace."
- ErrParse token
+ PsErrParse token
| null token
-> text "parse error (possibly incorrect indentation or mismatched brackets)"
| otherwise
-> text "parse error on input" <+> quotes (text token)
- ErrCmmLexer
+ PsErrCmmLexer
-> text "Cmm lexical error"
- ErrUnsupportedBoxedSumExpr s
+ PsErrUnsupportedBoxedSumExpr s
-> hang (text "Boxed sums not supported:") 2
(pprSumOrTuple Boxed s)
- ErrUnsupportedBoxedSumPat s
+ PsErrUnsupportedBoxedSumPat s
-> hang (text "Boxed sums not supported:") 2
(pprSumOrTuple Boxed s)
- ErrUnexpectedQualifiedConstructor v
+ PsErrUnexpectedQualifiedConstructor v
-> hang (text "Expected an unqualified type constructor:") 2
(ppr v)
- ErrTupleSectionInPat
+ PsErrTupleSectionInPat
-> text "Tuple section in pattern context"
- ErrIllegalBangPattern e
+ PsErrIllegalBangPattern e
-> text "Illegal bang-pattern (use BangPatterns):" $$ ppr e
- ErrOpFewArgs (StarIsType star_is_type) op
+ PsErrOpFewArgs (StarIsType star_is_type) op
-> text "Operator applied to too few arguments:" <+> ppr op
$$ starInfo star_is_type op
- ErrImportQualifiedTwice
+ PsErrImportQualifiedTwice
-> text "Multiple occurrences of 'qualified'"
- ErrImportPostQualified
+ PsErrImportPostQualified
-> text "Found" <+> quotes (text "qualified")
<+> text "in postpositive position. "
$$ text "To allow this, enable language extension 'ImportQualifiedPost'"
- ErrIllegalExplicitNamespace
+ PsErrIllegalExplicitNamespace
-> text "Illegal keyword 'type' (use ExplicitNamespaces to enable)"
- ErrVarForTyCon name
+ PsErrVarForTyCon name
-> text "Expecting a type constructor but found a variable,"
<+> quotes (ppr name) <> text "."
$$ if isSymOcc $ rdrNameOcc name
@@ -224,114 +224,114 @@ pp_err = \case
<+> text "then enable ExplicitNamespaces and use the 'type' keyword."
else empty
- ErrIllegalPatSynExport
+ PsErrIllegalPatSynExport
-> text "Illegal export form (use PatternSynonyms to enable)"
- ErrMalformedEntityString
+ PsErrMalformedEntityString
-> text "Malformed entity string"
- ErrDotsInRecordUpdate
+ PsErrDotsInRecordUpdate
-> text "You cannot use `..' in a record update"
- ErrPrecedenceOutOfRange i
+ PsErrPrecedenceOutOfRange i
-> text "Precedence out of range: " <> int i
- ErrInvalidDataCon t
+ PsErrInvalidDataCon t
-> hang (text "Cannot parse data constructor in a data/newtype declaration:") 2
(ppr t)
- ErrInvalidInfixDataCon lhs tc rhs
+ PsErrInvalidInfixDataCon lhs tc rhs
-> hang (text "Cannot parse an infix data constructor in a data/newtype declaration:")
2 (ppr lhs <+> ppr tc <+> ppr rhs)
- ErrUnpackDataCon
+ PsErrUnpackDataCon
-> text "{-# UNPACK #-} cannot be applied to a data constructor."
- ErrUnexpectedKindAppInDataCon lhs ki
+ PsErrUnexpectedKindAppInDataCon lhs ki
-> hang (text "Unexpected kind application in a data/newtype declaration:") 2
(ppr lhs <+> text "@" <> ppr ki)
- ErrInvalidRecordCon p
+ PsErrInvalidRecordCon p
-> text "Not a record constructor:" <+> ppr p
- ErrIllegalUnboxedStringInPat lit
+ PsErrIllegalUnboxedStringInPat lit
-> text "Illegal unboxed string literal in pattern:" $$ ppr lit
- ErrDoNotationInPat
+ PsErrDoNotationInPat
-> text "do-notation in pattern"
- ErrIfTheElseInPat
+ PsErrIfTheElseInPat
-> text "(if ... then ... else ...)-syntax in pattern"
- ErrLambdaCaseInPat
+ PsErrLambdaCaseInPat
-> text "(\\case ...)-syntax in pattern"
- ErrCaseInPat
+ PsErrCaseInPat
-> text "(case ... of ...)-syntax in pattern"
- ErrLetInPat
+ PsErrLetInPat
-> text "(let ... in ...)-syntax in pattern"
- ErrLambdaInPat
+ PsErrLambdaInPat
-> text "Lambda-syntax in pattern."
$$ text "Pattern matching on functions is not possible."
- ErrArrowExprInPat e
+ PsErrArrowExprInPat e
-> text "Expression syntax in pattern:" <+> ppr e
- ErrArrowCmdInPat c
+ PsErrArrowCmdInPat c
-> text "Command syntax in pattern:" <+> ppr c
- ErrArrowCmdInExpr c
+ PsErrArrowCmdInExpr c
-> vcat
[ text "Arrow command found where an expression was expected:"
, nest 2 (ppr c)
]
- ErrViewPatInExpr a b
+ PsErrViewPatInExpr a b
-> sep [ text "View pattern in expression context:"
, nest 4 (ppr a <+> text "->" <+> ppr b)
]
- ErrTypeAppWithoutSpace v e
+ PsErrTypeAppWithoutSpace v e
-> sep [ text "@-pattern in expression context:"
, nest 4 (pprPrefixOcc v <> text "@" <> ppr e)
]
$$ text "Type application syntax requires a space before '@'"
- ErrLazyPatWithoutSpace e
+ PsErrLazyPatWithoutSpace e
-> sep [ text "Lazy pattern in expression context:"
, nest 4 (text "~" <> ppr e)
]
$$ text "Did you mean to add a space after the '~'?"
- ErrBangPatWithoutSpace e
+ PsErrBangPatWithoutSpace e
-> sep [ text "Bang pattern in expression context:"
, nest 4 (text "!" <> ppr e)
]
$$ text "Did you mean to add a space after the '!'?"
- ErrUnallowedPragma prag
+ PsErrUnallowedPragma prag
-> hang (text "A pragma is not allowed in this position:") 2
(ppr prag)
- ErrQualifiedDoInCmd m
+ PsErrQualifiedDoInCmd m
-> hang (text "Parse error in command:") 2 $
text "Found a qualified" <+> ppr m <> text ".do block in a command, but"
$$ text "qualified 'do' is not supported in commands."
- ErrParseErrorInCmd s
+ PsErrParseErrorInCmd s
-> hang (text "Parse error in command:") 2 s
- ErrParseErrorInPat s
+ PsErrParseErrorInPat s
-> text "Parse error in pattern:" <+> s
- ErrInvalidInfixHole
+ PsErrInvalidInfixHole
-> text "Invalid infix hole, expected an infix operator"
- ErrSemiColonsInCondExpr c st t se e
+ PsErrSemiColonsInCondExpr c st t se e
-> text "Unexpected semi-colons in conditional:"
$$ nest 4 expr
$$ text "Perhaps you meant to use DoAndIfThenElse?"
@@ -342,7 +342,7 @@ pp_err = \case
text "then" <+> ppr t <> pprOptSemi se <+>
text "else" <+> ppr e
- ErrSemiColonsInCondCmd c st t se e
+ PsErrSemiColonsInCondCmd c st t se e
-> text "Unexpected semi-colons in conditional:"
$$ nest 4 expr
$$ text "Perhaps you meant to use DoAndIfThenElse?"
@@ -354,78 +354,78 @@ pp_err = \case
text "else" <+> ppr e
- ErrAtInPatPos
+ PsErrAtInPatPos
-> text "Found a binding for the"
<+> quotes (text "@")
<+> text "operator in a pattern position."
$$ perhaps_as_pat
- ErrLambdaCmdInFunAppCmd a
+ PsErrLambdaCmdInFunAppCmd a
-> pp_unexpected_fun_app (text "lambda command") a
- ErrCaseCmdInFunAppCmd a
+ PsErrCaseCmdInFunAppCmd a
-> pp_unexpected_fun_app (text "case command") a
- ErrIfCmdInFunAppCmd a
+ PsErrIfCmdInFunAppCmd a
-> pp_unexpected_fun_app (text "if command") a
- ErrLetCmdInFunAppCmd a
+ PsErrLetCmdInFunAppCmd a
-> pp_unexpected_fun_app (text "let command") a
- ErrDoCmdInFunAppCmd a
+ PsErrDoCmdInFunAppCmd a
-> pp_unexpected_fun_app (text "do command") a
- ErrDoInFunAppExpr m a
+ PsErrDoInFunAppExpr m a
-> pp_unexpected_fun_app (prependQualified m (text "do block")) a
- ErrMDoInFunAppExpr m a
+ PsErrMDoInFunAppExpr m a
-> pp_unexpected_fun_app (prependQualified m (text "mdo block")) a
- ErrLambdaInFunAppExpr a
+ PsErrLambdaInFunAppExpr a
-> pp_unexpected_fun_app (text "lambda expression") a
- ErrCaseInFunAppExpr a
+ PsErrCaseInFunAppExpr a
-> pp_unexpected_fun_app (text "case expression") a
- ErrLambdaCaseInFunAppExpr a
+ PsErrLambdaCaseInFunAppExpr a
-> pp_unexpected_fun_app (text "lambda-case expression") a
- ErrLetInFunAppExpr a
+ PsErrLetInFunAppExpr a
-> pp_unexpected_fun_app (text "let expression") a
- ErrIfInFunAppExpr a
+ PsErrIfInFunAppExpr a
-> pp_unexpected_fun_app (text "if expression") a
- ErrProcInFunAppExpr a
+ PsErrProcInFunAppExpr a
-> pp_unexpected_fun_app (text "proc expression") a
- ErrMalformedTyOrClDecl ty
+ PsErrMalformedTyOrClDecl ty
-> text "Malformed head of type or class declaration:"
<+> ppr ty
- ErrIllegalWhereInDataDecl
+ PsErrIllegalWhereInDataDecl
-> vcat
[ text "Illegal keyword 'where' in data declaration"
, text "Perhaps you intended to use GADTs or a similar language"
, text "extension to enable syntax: data T where"
]
- ErrIllegalTraditionalRecordSyntax s
+ PsErrIllegalTraditionalRecordSyntax s
-> text "Illegal record syntax (use TraditionalRecordSyntax):"
<+> s
- ErrParseErrorOnInput occ
+ PsErrParseErrorOnInput occ
-> text "parse error on input" <+> ftext (occNameFS occ)
- ErrIllegalDataTypeContext c
+ PsErrIllegalDataTypeContext c
-> text "Illegal datatype context (use DatatypeContexts):"
<+> pprLHsContext c
- ErrMalformedDecl what for
+ PsErrMalformedDecl what for
-> text "Malformed" <+> what
<+> text "declaration for" <+> quotes (ppr for)
- ErrUnexpectedTypeAppInDecl ki what for
+ PsErrUnexpectedTypeAppInDecl ki what for
-> vcat [ text "Unexpected type application"
<+> text "@" <> ppr ki
, text "In the" <+> what
@@ -433,35 +433,35 @@ pp_err = \case
<+> quotes (ppr for)
]
- ErrNotADataCon name
+ PsErrNotADataCon name
-> text "Not a data constructor:" <+> quotes (ppr name)
- ErrRecordSyntaxInPatSynDecl pat
+ PsErrRecordSyntaxInPatSynDecl pat
-> text "record syntax not supported for pattern synonym declarations:"
$$ ppr pat
- ErrEmptyWhereInPatSynDecl patsyn_name
+ PsErrEmptyWhereInPatSynDecl patsyn_name
-> text "pattern synonym 'where' clause cannot be empty"
$$ text "In the pattern synonym declaration for: "
<+> ppr (patsyn_name)
- ErrInvalidWhereBindInPatSynDecl patsyn_name decl
+ PsErrInvalidWhereBindInPatSynDecl patsyn_name decl
-> text "pattern synonym 'where' clause must bind the pattern synonym's name"
<+> quotes (ppr patsyn_name) $$ ppr decl
- ErrNoSingleWhereBindInPatSynDecl _patsyn_name decl
+ PsErrNoSingleWhereBindInPatSynDecl _patsyn_name decl
-> text "pattern synonym 'where' clause must contain a single binding:"
$$ ppr decl
- ErrDeclSpliceNotAtTopLevel d
+ PsErrDeclSpliceNotAtTopLevel d
-> hang (text "Declaration splices are allowed only"
<+> text "at the top level:")
2 (ppr d)
- ErrInferredTypeVarNotAllowed
+ PsErrInferredTypeVarNotAllowed
-> text "Inferred type variables are not allowed here"
- ErrIllegalRoleName role nearby
+ PsErrIllegalRoleName role nearby
-> text "Illegal role name" <+> quotes (ppr role)
$$ case nearby of
[] -> empty
@@ -470,17 +470,17 @@ pp_err = \case
_ -> hang (text "Perhaps you meant one of these:")
2 (pprWithCommas (quotes . ppr) nearby)
- ErrMultipleNamesInStandaloneKindSignature vs
+ PsErrMultipleNamesInStandaloneKindSignature vs
-> vcat [ hang (text "Standalone kind signatures do not support multiple names at the moment:")
2 (pprWithCommas ppr vs)
, text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
]
- ErrIllegalImportBundleForm
+ PsErrIllegalImportBundleForm
-> text "Illegal import form, this syntax can only be used to bundle"
$+$ text "pattern synonyms with types in module exports."
- ErrInvalidTypeSignature lhs
+ PsErrInvalidTypeSignature lhs
-> text "Invalid type signature:"
<+> ppr lhs
<+> text ":: ..."
@@ -507,7 +507,7 @@ pp_err = \case
default_RDR = mkUnqual varName (fsLit "default")
pattern_RDR = mkUnqual varName (fsLit "pattern")
- ErrUnexpectedTypeInDecl t what tc tparms equals_or_where
+ PsErrUnexpectedTypeInDecl t what tc tparms equals_or_where
-> vcat [ text "Unexpected type" <+> quotes (ppr t)
, text "In the" <+> what
<+> ptext (sLit "declaration for") <+> quotes tc'
@@ -524,20 +524,20 @@ pp_err = \case
-- wrote). See #14907
tc' = ppr $ filterCTuple tc
- ErrCmmParser cmm_err -> case cmm_err of
+ PsErrCmmParser cmm_err -> case cmm_err of
CmmUnknownPrimitive name -> text "unknown primitive" <+> ftext name
CmmUnknownMacro fun -> text "unknown macro" <+> ftext fun
CmmUnknownCConv cconv -> text "unknown calling convention:" <+> text cconv
CmmUnrecognisedSafety safety -> text "unrecognised safety" <+> text safety
CmmUnrecognisedHint hint -> text "unrecognised hint:" <+> text hint
- ErrExpectedHyphen
+ PsErrExpectedHyphen
-> text "Expected a hyphen"
- ErrSpaceInSCC
+ PsErrSpaceInSCC
-> text "Spaces are not allowed in SCCs"
- ErrEmptyDoubleQuotes th_on
+ PsErrEmptyDoubleQuotes th_on
-> if th_on then vcat (msg ++ th_msg) else vcat msg
where
msg = [ text "Parser error on `''`"
@@ -547,23 +547,23 @@ pp_err = \case
, text "but the type variable or constructor is missing"
]
- ErrInvalidPackageName pkg
+ PsErrInvalidPackageName pkg
-> vcat
[ text "Parse error" <> colon <+> quotes (ftext pkg)
, text "Version number or non-alphanumeric" <+>
text "character in package name"
]
- ErrInvalidRuleActivationMarker
+ PsErrInvalidRuleActivationMarker
-> text "Invalid rule activation marker"
- ErrLinearFunction
+ PsErrLinearFunction
-> text "Enable LinearTypes to allow linear functions"
- ErrMultiWayIf
+ PsErrMultiWayIf
-> text "Multi-way if-expressions need MultiWayIf turned on"
- ErrExplicitForall is_unicode
+ PsErrExplicitForall is_unicode
-> vcat
[ text "Illegal symbol" <+> quotes (forallSym is_unicode) <+> text "in type"
, text "Perhaps you intended to use RankNTypes or a similar language"
@@ -574,7 +574,7 @@ pp_err = \case
forallSym True = text "∀"
forallSym False = text "forall"
- ErrIllegalQualifiedDo qdoDoc
+ PsErrIllegalQualifiedDo qdoDoc
-> vcat
[ text "Illegal qualified" <+> quotes qdoDoc <+> text "block"
, text "Perhaps you intended to use QualifiedDo"
=====================================
compiler/GHC/Parser/Header.hs
=====================================
@@ -73,7 +73,7 @@ getImports :: ParserOpts -- ^ Parser options
-> FilePath -- ^ The original source filename (used for locations
-- in the function result)
-> IO (Either
- (Bag Error)
+ (Bag PsError)
([(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)],
Located ModuleName))
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -353,7 +353,7 @@ $tab { warnTab }
}
<0,option_prags> {
- "{-#" { warnThen Opt_WarnUnrecognisedPragmas WarnUnrecognisedPragma
+ "{-#" { warnThen Opt_WarnUnrecognisedPragmas PsWarnUnrecognisedPragma
(nested_comment lexToken) }
}
@@ -1103,7 +1103,7 @@ hopefully_open_brace span buf len
Layout prev_off _ : _ -> prev_off < offset
_ -> True
if isOK then pop_and open_brace span buf len
- else addFatalError $ Error ErrMissingBlock [] (mkSrcSpanPs span)
+ else addFatalError $ PsError PsErrMissingBlock [] (mkSrcSpanPs span)
pop_and :: Action -> Action
pop_and act span buf len = do _ <- popLexState
@@ -1482,7 +1482,7 @@ docCommentEnd input commentAcc docType buf span = do
commentEnd lexToken input commentAcc finalizeComment buf span
errBrace :: AlexInput -> RealSrcSpan -> P a
-errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) (psRealLoc end) (Error (ErrLexer LexUnterminatedComment LexErrKind_EOF) [])
+errBrace (AI end _) span = failLocMsgP (realSrcSpanStart span) (psRealLoc end) (PsError (PsErrLexer LexUnterminatedComment LexErrKind_EOF) [])
open_brace, close_brace :: Action
open_brace span _str _len = do
@@ -1541,7 +1541,7 @@ varid span buf len =
lambdaCase <- getBit LambdaCaseBit
unless lambdaCase $ do
pState <- getPState
- addError $ Error ErrLambdaCase [] (mkSrcSpanPs (last_loc pState))
+ addError $ PsError PsErrLambdaCase [] (mkSrcSpanPs (last_loc pState))
return ITlcase
_ -> return ITcase
maybe_layout keyword
@@ -1574,7 +1574,7 @@ varsym_prefix :: Action
varsym_prefix = sym $ \span exts s ->
let warnExtConflict errtok =
do { addWarning Opt_WarnOperatorWhitespaceExtConflict $
- WarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok
+ PsWarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok
; return (ITvarsym s) }
in
if | s == fsLit "@" ->
@@ -1598,17 +1598,17 @@ varsym_prefix = sym $ \span exts s ->
| s == fsLit "~" -> return ITtilde
| otherwise ->
do { addWarning Opt_WarnOperatorWhitespace $
- WarnOperatorWhitespace (mkSrcSpanPs span) s
+ PsWarnOperatorWhitespace (mkSrcSpanPs span) s
OperatorWhitespaceOccurrence_Prefix
; return (ITvarsym s) }
-- See Note [Whitespace-sensitive operator parsing]
varsym_suffix :: Action
varsym_suffix = sym $ \span _ s ->
- if | s == fsLit "@" -> failMsgP (Error ErrSuffixAT [])
+ if | s == fsLit "@" -> failMsgP (PsError PsErrSuffixAT [])
| otherwise ->
do { addWarning Opt_WarnOperatorWhitespace $
- WarnOperatorWhitespace (mkSrcSpanPs span) s
+ PsWarnOperatorWhitespace (mkSrcSpanPs span) s
OperatorWhitespaceOccurrence_Suffix
; return (ITvarsym s) }
@@ -1618,7 +1618,7 @@ varsym_tight_infix = sym $ \span _ s ->
if | s == fsLit "@" -> return ITat
| otherwise ->
do { addWarning Opt_WarnOperatorWhitespace $
- WarnOperatorWhitespace (mkSrcSpanPs span) s
+ PsWarnOperatorWhitespace (mkSrcSpanPs span) s
OperatorWhitespaceOccurrence_TightInfix
; return (ITvarsym s) }
@@ -1666,7 +1666,7 @@ tok_integral itint transint transbuf translen (radix,char_to_int) span buf len =
let src = lexemeToString buf len
when ((not numericUnderscores) && ('_' `elem` src)) $ do
pState <- getPState
- addError $ Error (ErrNumUnderscores NumUnderscore_Integral) [] (mkSrcSpanPs (last_loc pState))
+ addError $ PsError (PsErrNumUnderscores NumUnderscore_Integral) [] (mkSrcSpanPs (last_loc pState))
return $ L span $ itint (SourceText src)
$! transint $ parseUnsignedInteger
(offsetBytes transbuf buf) (subtract translen len) radix char_to_int
@@ -1707,7 +1707,7 @@ tok_frac drop f span buf len = do
let src = lexemeToString buf (len-drop)
when ((not numericUnderscores) && ('_' `elem` src)) $ do
pState <- getPState
- addError $ Error (ErrNumUnderscores NumUnderscore_Float) [] (mkSrcSpanPs (last_loc pState))
+ addError $ PsError (PsErrNumUnderscores NumUnderscore_Float) [] (mkSrcSpanPs (last_loc pState))
return (L span $! (f $! src))
tok_float, tok_primfloat, tok_primdouble :: String -> Token
@@ -1877,7 +1877,7 @@ lex_string_prag mkTok span _buf _len
= case alexGetChar i of
Just (c,i') | c == x -> isString i' xs
_other -> False
- err (AI end _) = failLocMsgP (realSrcSpanStart (psRealSpan span)) (psRealLoc end) (Error (ErrLexer LexUnterminatedOptions LexErrKind_EOF) [])
+ err (AI end _) = failLocMsgP (realSrcSpanStart (psRealSpan span)) (psRealLoc end) (PsError (PsErrLexer LexUnterminatedOptions LexErrKind_EOF) [])
-- -----------------------------------------------------------------------------
@@ -1915,7 +1915,7 @@ lex_string s = do
setInput i
when (any (> '\xFF') s') $ do
pState <- getPState
- let err = Error ErrPrimStringInvalidChar [] (mkSrcSpanPs (last_loc pState))
+ let err = PsError PsErrPrimStringInvalidChar [] (mkSrcSpanPs (last_loc pState))
addError err
return (ITprimstring (SourceText s') (unsafeMkByteString s'))
_other ->
@@ -2178,7 +2178,7 @@ quasiquote_error :: RealSrcLoc -> P a
quasiquote_error start = do
(AI end buf) <- getInput
reportLexError start (psRealLoc end) buf
- (\k -> Error (ErrLexer LexUnterminatedQQ k) [])
+ (\k -> PsError (PsErrLexer LexUnterminatedQQ k) [])
-- -----------------------------------------------------------------------------
-- Warnings
@@ -2188,7 +2188,7 @@ warnTab srcspan _buf _len = do
addTabWarning (psRealSpan srcspan)
lexToken
-warnThen :: WarningFlag -> (SrcSpan -> Warning) -> Action -> Action
+warnThen :: WarningFlag -> (SrcSpan -> PsWarning) -> Action -> Action
warnThen flag warning action srcspan buf len = do
addWarning flag (warning (RealSrcSpan (psRealSpan srcspan) Nothing))
action srcspan buf len
@@ -2248,8 +2248,8 @@ data HdkComment
data PState = PState {
buffer :: StringBuffer,
options :: ParserOpts,
- warnings :: Bag Warning,
- errors :: Bag Error,
+ warnings :: Bag PsWarning,
+ errors :: Bag PsError,
tab_first :: Maybe RealSrcSpan, -- pos of first tab warning in the file
tab_count :: !Word, -- number of tab warnings in the file
last_tk :: Maybe Token,
@@ -2329,12 +2329,12 @@ thenP :: P a -> (a -> P b) -> P b
POk s1 a -> (unP (k a)) s1
PFailed s1 -> PFailed s1
-failMsgP :: (SrcSpan -> Error) -> P a
+failMsgP :: (SrcSpan -> PsError) -> P a
failMsgP f = do
pState <- getPState
addFatalError (f (mkSrcSpanPs (last_loc pState)))
-failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> Error) -> P a
+failLocMsgP :: RealSrcLoc -> RealSrcLoc -> (SrcSpan -> PsError) -> P a
failLocMsgP loc1 loc2 f =
addFatalError (f (RealSrcSpan (mkRealSrcSpan loc1 loc2) Nothing))
@@ -2786,15 +2786,15 @@ class Monad m => MonadP m where
-- to the accumulator and parsing continues. This allows GHC to report
-- more than one parse error per file.
--
- addError :: Error -> m ()
+ addError :: PsError -> m ()
-- | Add a warning to the accumulator.
-- Use 'getMessages' to get the accumulated warnings.
- addWarning :: WarningFlag -> Warning -> m ()
+ addWarning :: WarningFlag -> PsWarning -> m ()
-- | Add a fatal error. This will be the last error reported by the parser, and
-- the parser will not produce any result, ending in a 'PFailed' state.
- addFatalError :: Error -> m a
+ addFatalError :: PsError -> m a
-- | Check if a given flag is currently set in the bitmap.
getBit :: ExtBits -> m Bool
@@ -2840,19 +2840,19 @@ addTabWarning srcspan
-- | Get a bag of the errors that have been accumulated so far.
-- Does not take -Werror into account.
-getErrorMessages :: PState -> Bag Error
+getErrorMessages :: PState -> Bag PsError
getErrorMessages p = errors p
-- | Get the warnings and errors accumulated so far.
-- Does not take -Werror into account.
-getMessages :: PState -> (Bag Warning, Bag Error)
+getMessages :: PState -> (Bag PsWarning, Bag PsError)
getMessages p =
let ws = warnings p
-- we add the tabulation warning on the fly because
-- we count the number of occurences of tab characters
ws' = case tab_first p of
Nothing -> ws
- Just tf -> WarnTab (RealSrcSpan tf Nothing) (tab_count p)
+ Just tf -> PsWarnTab (RealSrcSpan tf Nothing) (tab_count p)
`consBag` ws
in (ws', errors p)
@@ -2900,8 +2900,8 @@ srcParseErr
-> StringBuffer -- current buffer (placed just after the last token)
-> Int -- length of the previous token
-> SrcSpan
- -> Error
-srcParseErr options buf len loc = Error (ErrParse token) suggests loc
+ -> PsError
+srcParseErr options buf len loc = PsError (PsErrParse token) suggests loc
where
token = lexemeToString (offsetBytes (-len) buf) len
pattern = decodePrevNChars 8 buf
@@ -2936,7 +2936,7 @@ lexError e = do
loc <- getRealSrcLoc
(AI end buf) <- getInput
reportLexError loc (psRealLoc end) buf
- (\k -> Error (ErrLexer e k) [])
+ (\k -> PsError (PsErrLexer e k) [])
-- -----------------------------------------------------------------------------
-- This is the top-level function: called from the parser each time a
@@ -3052,7 +3052,7 @@ alternativeLayoutRuleToken t
(ITwhere, ALRLayout _ col : ls, _)
| newLine && thisCol == col && transitional ->
do addWarning Opt_WarnAlternativeLayoutRuleTransitional
- $ WarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Where
+ $ PsWarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Where
setALRContext ls
setNextToken t
-- Note that we use lastLoc, as we may need to close
@@ -3062,7 +3062,7 @@ alternativeLayoutRuleToken t
(ITvbar, ALRLayout _ col : ls, _)
| newLine && thisCol == col && transitional ->
do addWarning Opt_WarnAlternativeLayoutRuleTransitional
- $ WarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Pipe
+ $ PsWarnTransitionalLayout (mkSrcSpanPs thisLoc) TransLayout_Pipe
setALRContext ls
setNextToken t
-- Note that we use lastLoc, as we may need to close
@@ -3184,7 +3184,7 @@ lexToken = do
return (L span ITeof)
AlexError (AI loc2 buf) ->
reportLexError (psRealLoc loc1) (psRealLoc loc2) buf
- (\k -> Error (ErrLexer LexError k) [])
+ (\k -> PsError (PsErrLexer LexError k) [])
AlexSkip inp2 _ -> do
setInput inp2
lexToken
@@ -3198,7 +3198,7 @@ lexToken = do
unless (isComment lt') (setLastTk lt')
return lt
-reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> (LexErrKind -> SrcSpan -> Error) -> P a
+reportLexError :: RealSrcLoc -> RealSrcLoc -> StringBuffer -> (LexErrKind -> SrcSpan -> PsError) -> P a
reportLexError loc1 loc2 buf f
| atEnd buf = failLocMsgP loc1 loc2 (f LexErrKind_EOF)
| otherwise =
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -260,12 +260,12 @@ mkStandaloneKindSig loc lhs rhs =
check_lhs_name v@(unLoc->name) =
if isUnqual name && isTcOcc (rdrNameOcc name)
then return v
- else addFatalError $ Error (ErrUnexpectedQualifiedConstructor (unLoc v)) [] (getLoc v)
+ else addFatalError $ PsError (PsErrUnexpectedQualifiedConstructor (unLoc v)) [] (getLoc v)
check_singular_lhs vs =
case vs of
[] -> panic "mkStandaloneKindSig: empty left-hand side"
[v] -> return v
- _ -> addFatalError $ Error (ErrMultipleNamesInStandaloneKindSignature vs) [] (getLoc lhs)
+ _ -> addFatalError $ PsError (PsErrMultipleNamesInStandaloneKindSignature vs) [] (getLoc lhs)
mkTyFamInstEqn :: HsOuterFamEqnTyVarBndrs GhcPs
-> LHsType GhcPs
@@ -374,7 +374,7 @@ mkRoleAnnotDecl loc tycon roles
let nearby = fuzzyLookup (unpackFS role)
(mapFst unpackFS possible_roles)
in
- addFatalError $ Error (ErrIllegalRoleName role nearby) [] loc_role
+ addFatalError $ PsError (PsErrIllegalRoleName role nearby) [] loc_role
-- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to
-- binders without annotations. Only accepts specified variables, and errors if
@@ -394,7 +394,7 @@ fromSpecTyVarBndr bndr = case bndr of
where
check_spec :: Specificity -> SrcSpan -> P ()
check_spec SpecifiedSpec _ = return ()
- check_spec InferredSpec loc = addFatalError $ Error ErrInferredTypeVarNotAllowed [] loc
+ check_spec InferredSpec loc = addFatalError $ PsError PsErrInferredTypeVarNotAllowed [] loc
{- **********************************************************************
@@ -445,7 +445,7 @@ cvBindsAndSigs fb = do
-- called on top-level declarations.
drop_bad_decls [] = return []
drop_bad_decls (L l (SpliceD _ d) : ds) = do
- addError $ Error (ErrDeclSpliceNotAtTopLevel d) [] l
+ addError $ PsError (PsErrDeclSpliceNotAtTopLevel d) [] l
drop_bad_decls ds
drop_bad_decls (d:ds) = (d:) <$> drop_bad_decls ds
@@ -550,14 +550,14 @@ constructor, a type, or a context, we would need unlimited lookahead which
-- | Reinterpret a type constructor, including type operators, as a data
-- constructor.
-- See Note [Parsing data constructors is hard]
-tyConToDataCon :: SrcSpan -> RdrName -> Either Error (Located RdrName)
+tyConToDataCon :: SrcSpan -> RdrName -> Either PsError (Located RdrName)
tyConToDataCon loc tc
| isTcOcc occ || isDataOcc occ
, isLexCon (occNameFS occ)
= return (L loc (setRdrNameSpace tc srcDataName))
| otherwise
- = Left $ Error (ErrNotADataCon tc) [] loc
+ = Left $ PsError (PsErrNotADataCon tc) [] loc
where
occ = rdrNameOcc tc
@@ -597,17 +597,17 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
fromDecl (L loc decl) = extraDeclErr loc decl
extraDeclErr loc decl =
- addFatalError $ Error (ErrNoSingleWhereBindInPatSynDecl patsyn_name decl) [] loc
+ addFatalError $ PsError (PsErrNoSingleWhereBindInPatSynDecl patsyn_name decl) [] loc
wrongNameBindingErr loc decl =
- addFatalError $ Error (ErrInvalidWhereBindInPatSynDecl patsyn_name decl) [] loc
+ addFatalError $ PsError (PsErrInvalidWhereBindInPatSynDecl patsyn_name decl) [] loc
wrongNumberErr loc =
- addFatalError $ Error (ErrEmptyWhereInPatSynDecl patsyn_name) [] loc
+ addFatalError $ PsError (PsErrEmptyWhereInPatSynDecl patsyn_name) [] loc
recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a
recordPatSynErr loc pat =
- addFatalError $ Error (ErrRecordSyntaxInPatSynDecl pat) [] loc
+ addFatalError $ PsError (PsErrRecordSyntaxInPatSynDecl pat) [] loc
mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
@@ -737,7 +737,7 @@ to make setRdrNameSpace partial, so we just make an Unqual name instead. It
really doesn't matter!
-}
-eitherToP :: MonadP m => Either Error a -> m a
+eitherToP :: MonadP m => Either PsError a -> m a
-- Adapts the Either monad to the P monad
eitherToP (Left err) = addFatalError err
eitherToP (Right thing) = return thing
@@ -751,9 +751,9 @@ checkTyVars pp_what equals_or_where tc tparms
= do { (tvs, anns) <- fmap unzip $ mapM check tparms
; return (mkHsQTvs tvs, concat anns) }
where
- check (HsTypeArg _ ki@(L loc _)) = addFatalError $ Error (ErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] loc
+ check (HsTypeArg _ ki@(L loc _)) = addFatalError $ PsError (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] loc
check (HsValArg ty) = chkParens [] ty
- check (HsArgPar sp) = addFatalError $ Error (ErrMalformedDecl pp_what (unLoc tc)) [] sp
+ check (HsArgPar sp) = addFatalError $ PsError (PsErrMalformedDecl pp_what (unLoc tc)) [] sp
-- Keep around an action for adjusting the annotations of extra parens
chkParens :: [AddAnn] -> LHsType GhcPs
-> P (LHsTyVarBndr () GhcPs, [AddAnn])
@@ -769,7 +769,7 @@ checkTyVars pp_what equals_or_where tc tparms
chk (L l (HsTyVar _ _ (L ltv tv)))
| isRdrTyVar tv = return (L l (UserTyVar noExtField () (L ltv tv)))
chk t@(L loc _)
- = addFatalError $ Error (ErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where) [] loc
+ = addFatalError $ PsError (PsErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where) [] loc
whereDots, equalsDots :: SDoc
@@ -781,7 +781,7 @@ checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Nothing = return ()
checkDatatypeContext (Just c)
= do allowed <- getBit DatatypeContextsBit
- unless allowed $ addError $ Error (ErrIllegalDataTypeContext c) [] (getLoc c)
+ unless allowed $ addError $ PsError (PsErrIllegalDataTypeContext c) [] (getLoc c)
type LRuleTyTmVar = Located RuleTyTmVar
data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs))
@@ -811,13 +811,13 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
where check (L loc (Unqual occ)) =
-- TODO: don't use string here, OccName has a Unique/FastString
when ((occNameString occ ==) `any` ["forall","family","role"])
- (addFatalError $ Error (ErrParseErrorOnInput occ) [] loc)
+ (addFatalError $ PsError (PsErrParseErrorOnInput occ) [] loc)
check _ = panic "checkRuleTyVarBndrNames"
checkRecordSyntax :: (MonadP m, Outputable a) => Located a -> m (Located a)
checkRecordSyntax lr@(L loc r)
= do allowed <- getBit TraditionalRecordSyntaxBit
- unless allowed $ addError $ Error (ErrIllegalTraditionalRecordSyntax (ppr r)) [] loc
+ unless allowed $ addError $ PsError (PsErrIllegalTraditionalRecordSyntax (ppr r)) [] loc
return lr
-- | Check if the gadt_constrlist is empty. Only raise parse error for
@@ -826,7 +826,7 @@ checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
-> P (Located ([AddAnn], [LConDecl GhcPs]))
checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration.
= do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax
- unless gadtSyntax $ addError $ Error ErrIllegalWhereInDataDecl [] span
+ unless gadtSyntax $ addError $ PsError PsErrIllegalWhereInDataDecl [] span
return gadts
checkEmptyGADTs gadts = return gadts -- Ordinary GADT declaration.
@@ -848,7 +848,7 @@ checkTyClHdr is_cls ty
-- workaround to define '*' despite StarIsType
go lp (HsParTy _ (L l (HsStarTy _ isUni))) acc ann fix
- = do { addWarning Opt_WarnStarBinder (WarnStarBinder l)
+ = do { addWarning Opt_WarnStarBinder (PsWarnStarBinder l)
; let name = mkOccName tcClsName (starSym isUni)
; return (L l (Unqual name), acc, fix, (ann ++ mkParensApiAnn lp)) }
@@ -867,7 +867,7 @@ checkTyClHdr is_cls ty
| otherwise = getName (tupleTyCon Boxed arity)
-- See Note [Unit tuples] in GHC.Hs.Type (TODO: is this still relevant?)
go l _ _ _ _
- = addFatalError $ Error (ErrMalformedTyOrClDecl ty) [] l
+ = addFatalError $ PsError (PsErrMalformedTyOrClDecl ty) [] l
-- | Yield a parse error if we have a function applied directly to a do block
-- etc. and BlockArguments is not enabled.
@@ -877,29 +877,29 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
where
checkExpr :: LHsExpr GhcPs -> PV ()
checkExpr expr = case unLoc expr of
- HsDo _ (DoExpr m) _ -> check (ErrDoInFunAppExpr m) expr
- HsDo _ (MDoExpr m) _ -> check (ErrMDoInFunAppExpr m) expr
- HsLam {} -> check ErrLambdaInFunAppExpr expr
- HsCase {} -> check ErrCaseInFunAppExpr expr
- HsLamCase {} -> check ErrLambdaCaseInFunAppExpr expr
- HsLet {} -> check ErrLetInFunAppExpr expr
- HsIf {} -> check ErrIfInFunAppExpr expr
- HsProc {} -> check ErrProcInFunAppExpr expr
+ HsDo _ (DoExpr m) _ -> check (PsErrDoInFunAppExpr m) expr
+ HsDo _ (MDoExpr m) _ -> check (PsErrMDoInFunAppExpr m) expr
+ HsLam {} -> check PsErrLambdaInFunAppExpr expr
+ HsCase {} -> check PsErrCaseInFunAppExpr expr
+ HsLamCase {} -> check PsErrLambdaCaseInFunAppExpr expr
+ HsLet {} -> check PsErrLetInFunAppExpr expr
+ HsIf {} -> check PsErrIfInFunAppExpr expr
+ HsProc {} -> check PsErrProcInFunAppExpr expr
_ -> return ()
checkCmd :: LHsCmd GhcPs -> PV ()
checkCmd cmd = case unLoc cmd of
- HsCmdLam {} -> check ErrLambdaCmdInFunAppCmd cmd
- HsCmdCase {} -> check ErrCaseCmdInFunAppCmd cmd
- HsCmdIf {} -> check ErrIfCmdInFunAppCmd cmd
- HsCmdLet {} -> check ErrLetCmdInFunAppCmd cmd
- HsCmdDo {} -> check ErrDoCmdInFunAppCmd cmd
+ HsCmdLam {} -> check PsErrLambdaCmdInFunAppCmd cmd
+ HsCmdCase {} -> check PsErrCaseCmdInFunAppCmd cmd
+ HsCmdIf {} -> check PsErrIfCmdInFunAppCmd cmd
+ HsCmdLet {} -> check PsErrLetCmdInFunAppCmd cmd
+ HsCmdDo {} -> check PsErrDoCmdInFunAppCmd cmd
_ -> return ()
check err a = do
blockArguments <- getBit BlockArgumentsBit
unless blockArguments $
- addError $ Error (err a) [] (getLoc a)
+ addError $ PsError (err a) [] (getLoc a)
-- | Validate the context constraints and break up a context into a list
-- of predicates.
@@ -1014,7 +1014,7 @@ checkAPat loc e0 = do
-- Improve error messages for the @-operator when the user meant an @-pattern
PatBuilderOpApp _ op _ | opIsAt (unLoc op) -> do
- addError $ Error ErrAtInPatPos [] (getLoc op)
+ addError $ PsError PsErrAtInPatPos [] (getLoc op)
return (WildPat noExtField)
PatBuilderOpApp l (L cl c) r
@@ -1046,7 +1046,7 @@ checkPatField (L l fld) = do p <- checkLPat (hsRecFieldArg fld)
return (L l (fld { hsRecFieldArg = p }))
patFail :: SrcSpan -> SDoc -> PV a
-patFail loc e = addFatalError $ Error (ErrParseErrorInPat e) [] loc
+patFail loc e = addFatalError $ PsError (PsErrParseErrorInPat e) [] loc
patIsRec :: RdrName -> Bool
patIsRec e = e == mkUnqual varName (fsLit "rec")
@@ -1138,11 +1138,11 @@ checkValSigLhs (L _ (HsVar _ lrdr@(L _ v)))
= return lrdr
checkValSigLhs lhs@(L l _)
- = addFatalError $ Error (ErrInvalidTypeSignature lhs) [] l
+ = addFatalError $ PsError (PsErrInvalidTypeSignature lhs) [] l
checkDoAndIfThenElse
:: (Outputable a, Outputable b, Outputable c)
- => (a -> Bool -> b -> Bool -> c -> ErrorDesc)
+ => (a -> Bool -> b -> Bool -> c -> PsErrorDesc)
-> Located a -> Bool -> Located b -> Bool -> Located c -> PV ()
checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr
| semiThen || semiElse = do
@@ -1152,7 +1152,7 @@ checkDoAndIfThenElse err guardExpr semiThen thenExpr semiElse elseExpr
semiElse (unLoc elseExpr)
loc = combineLocs guardExpr elseExpr
- unless doAndIfThenElse $ addError (Error e [] loc)
+ unless doAndIfThenElse $ addError (PsError e [] loc)
| otherwise = return ()
isFunLhs :: Located (PatBuilder GhcPs)
@@ -1259,7 +1259,7 @@ instance DisambInfixOp (HsExpr GhcPs) where
instance DisambInfixOp RdrName where
mkHsConOpPV (L l v) = return $ L l v
mkHsVarOpPV (L l v) = return $ L l v
- mkHsInfixHolePV l = addFatalError $ Error ErrInvalidInfixHole [] l
+ mkHsInfixHolePV l = addFatalError $ PsError PsErrInvalidInfixHole [] l
-- | Disambiguate constructs that may appear when we do not know ahead of time whether we are
-- parsing an expression, a command, or a pattern.
@@ -1415,10 +1415,10 @@ instance DisambECP (HsCmd GhcPs) where
return $ L l (HsCmdApp noExtField c e)
mkHsAppTypePV l c t = cmdFail l (ppr c <+> text "@" <> ppr t)
mkHsIfPV l c semi1 a semi2 b = do
- checkDoAndIfThenElse ErrSemiColonsInCondCmd c semi1 a semi2 b
+ checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b
return $ L l (mkHsCmdIf c a b)
mkHsDoPV l Nothing stmts = return $ L l (HsCmdDo noExtField stmts)
- mkHsDoPV l (Just m) _ = addFatalError $ Error (ErrQualifiedDoInCmd m) [] l
+ mkHsDoPV l (Just m) _ = addFatalError $ PsError (PsErrQualifiedDoInCmd m) [] l
mkHsParPV l c = return $ L l (HsCmdPar noExtField c)
mkHsVarPV (L l v) = cmdFail l (ppr v)
mkHsLitPV (L l a) = cmdFail l (ppr a)
@@ -1447,12 +1447,12 @@ instance DisambECP (HsCmd GhcPs) where
rejectPragmaPV _ = return ()
cmdFail :: SrcSpan -> SDoc -> PV a
-cmdFail loc e = addFatalError $ Error (ErrParseErrorInCmd e) [] loc
+cmdFail loc e = addFatalError $ PsError (PsErrParseErrorInCmd e) [] loc
instance DisambECP (HsExpr GhcPs) where
type Body (HsExpr GhcPs) = HsExpr
ecpFromCmd' (L l c) = do
- addError $ Error (ErrArrowCmdInExpr c) [] l
+ addError $ PsError (PsErrArrowCmdInExpr c) [] l
return (L l hsHoleExpr)
ecpFromExp' = return
mkHsLamPV l mg = return $ L l (HsLam noExtField mg)
@@ -1473,7 +1473,7 @@ instance DisambECP (HsExpr GhcPs) where
checkExpBlockArguments e
return $ L l (HsAppType noExtField e (mkHsWildCardBndrs t))
mkHsIfPV l c semi1 a semi2 b = do
- checkDoAndIfThenElse ErrSemiColonsInCondExpr c semi1 a semi2 b
+ checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b
return $ L l (mkHsIf c a b)
mkHsDoPV l mod stmts = return $ L l (HsDo noExtField (DoExpr mod) stmts)
mkHsParPV l e = return $ L l (HsPar noExtField e)
@@ -1489,19 +1489,19 @@ instance DisambECP (HsExpr GhcPs) where
checkRecordSyntax (L l r)
mkHsNegAppPV l a = return $ L l (NegApp noExtField a noSyntaxExpr)
mkHsSectionR_PV l op e = return $ L l (SectionR noExtField op e)
- mkHsViewPatPV l a b = addError (Error (ErrViewPatInExpr a b) [] l)
+ mkHsViewPatPV l a b = addError (PsError (PsErrViewPatInExpr a b) [] l)
>> return (L l hsHoleExpr)
- mkHsAsPatPV l v e = addError (Error (ErrTypeAppWithoutSpace (unLoc v) e) [] l)
+ mkHsAsPatPV l v e = addError (PsError (PsErrTypeAppWithoutSpace (unLoc v) e) [] l)
>> return (L l hsHoleExpr)
- mkHsLazyPatPV l e = addError (Error (ErrLazyPatWithoutSpace e) [] l)
+ mkHsLazyPatPV l e = addError (PsError (PsErrLazyPatWithoutSpace e) [] l)
>> return (L l hsHoleExpr)
- mkHsBangPatPV l e = addError (Error (ErrBangPatWithoutSpace e) [] l)
+ mkHsBangPatPV l e = addError (PsError (PsErrBangPatWithoutSpace e) [] l)
>> return (L l hsHoleExpr)
mkSumOrTuplePV = mkSumOrTupleExpr
rejectPragmaPV (L _ (OpApp _ _ _ e)) =
-- assuming left-associative parsing of operators
rejectPragmaPV e
- rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ Error (ErrUnallowedPragma prag) [] l
+ rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ PsError (PsErrUnallowedPragma prag) [] l
rejectPragmaPV _ = return ()
hsHoleExpr :: HsExpr GhcPs
@@ -1509,21 +1509,21 @@ hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
instance DisambECP (PatBuilder GhcPs) where
type Body (PatBuilder GhcPs) = PatBuilder
- ecpFromCmd' (L l c) = addFatalError $ Error (ErrArrowCmdInPat c) [] l
- ecpFromExp' (L l e) = addFatalError $ Error (ErrArrowExprInPat e) [] l
- mkHsLamPV l _ = addFatalError $ Error ErrLambdaInPat [] l
- mkHsLetPV l _ _ = addFatalError $ Error ErrLetInPat [] l
+ ecpFromCmd' (L l c) = addFatalError $ PsError (PsErrArrowCmdInPat c) [] l
+ ecpFromExp' (L l e) = addFatalError $ PsError (PsErrArrowExprInPat e) [] l
+ mkHsLamPV l _ = addFatalError $ PsError PsErrLambdaInPat [] l
+ mkHsLetPV l _ _ = addFatalError $ PsError PsErrLetInPat [] l
type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp m = m
mkHsOpAppPV l p1 op p2 = return $ L l $ PatBuilderOpApp p1 op p2
- mkHsCasePV l _ _ = addFatalError $ Error ErrCaseInPat [] l
- mkHsLamCasePV l _ = addFatalError $ Error ErrLambdaCaseInPat [] l
+ mkHsCasePV l _ _ = addFatalError $ PsError PsErrCaseInPat [] l
+ mkHsLamCasePV l _ = addFatalError $ PsError PsErrLambdaCaseInPat [] l
type FunArg (PatBuilder GhcPs) = PatBuilder GhcPs
superFunArg m = m
mkHsAppPV l p1 p2 = return $ L l (PatBuilderApp p1 p2)
mkHsAppTypePV l p t = return $ L l (PatBuilderAppType p (mkHsPatSigType t))
- mkHsIfPV l _ _ _ _ _ = addFatalError $ Error ErrIfTheElseInPat [] l
- mkHsDoPV l _ _ = addFatalError $ Error ErrDoNotationInPat [] l
+ mkHsIfPV l _ _ _ _ _ = addFatalError $ PsError PsErrIfTheElseInPat [] l
+ mkHsDoPV l _ _ = addFatalError $ PsError PsErrDoNotationInPat [] l
mkHsParPV l p = return $ L l (PatBuilderPar p)
mkHsVarPV v@(getLoc -> l) = return $ L l (PatBuilderVar v)
mkHsLitPV lit@(L l a) = do
@@ -1568,7 +1568,7 @@ checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
checkUnboxedStringLitPat (L loc lit) =
case lit of
HsStringPrim _ _ -- Trac #13260
- -> addFatalError $ Error (ErrIllegalUnboxedStringInPat lit) [] loc
+ -> addFatalError $ PsError (PsErrIllegalUnboxedStringInPat lit) [] loc
_ -> return ()
mkPatRec ::
@@ -1584,7 +1584,7 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
, pat_args = RecCon (HsRecFields fs dd)
}
mkPatRec p _ =
- addFatalError $ Error (ErrInvalidRecordCon (unLoc p)) [] (getLoc p)
+ addFatalError $ PsError (PsErrInvalidRecordCon (unLoc p)) [] (getLoc p)
-- | Disambiguate constructs that may appear when we do not know
-- ahead of time whether we are parsing a type or a newtype/data constructor.
@@ -1648,7 +1648,7 @@ instance DisambTD DataConBuilder where
panic "mkHsAppTyPV: InfixDataConBuilder"
mkHsAppKindTyPV lhs l_at ki =
- addFatalError $ Error (ErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) [] l_at
+ addFatalError $ PsError (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki)) [] l_at
mkHsOpTyPV lhs (L l_tc tc) rhs = do
check_no_ops (unLoc rhs) -- check the RHS because parsing type operators is right-associative
@@ -1658,7 +1658,7 @@ instance DisambTD DataConBuilder where
l = combineLocs lhs rhs
check_no_ops (HsBangTy _ _ t) = check_no_ops (unLoc t)
check_no_ops (HsOpTy{}) =
- addError $ Error (ErrInvalidInfixDataCon (unLoc lhs) tc (unLoc rhs)) [] l
+ addError $ PsError (PsErrInvalidInfixDataCon (unLoc lhs) tc (unLoc rhs)) [] l
check_no_ops _ = return ()
mkUnpackednessPV unpk constr_stuff
@@ -1669,7 +1669,7 @@ instance DisambTD DataConBuilder where
let l = combineLocs unpk constr_stuff
return $ L l (InfixDataConBuilder lhs' data_con rhs)
| otherwise =
- do addError $ Error ErrUnpackDataCon [] (getLoc unpk)
+ do addError $ PsError PsErrUnpackDataCon [] (getLoc unpk)
return constr_stuff
tyToDataConBuilder :: LHsType GhcPs -> PV (Located DataConBuilder)
@@ -1680,7 +1680,7 @@ tyToDataConBuilder (L l (HsTupleTy _ HsBoxedOrConstraintTuple ts)) = do
let data_con = L l (getRdrName (tupleDataCon Boxed (length ts)))
return $ L l (PrefixDataConBuilder (toOL ts) data_con)
tyToDataConBuilder t =
- addFatalError $ Error (ErrInvalidDataCon (unLoc t)) [] (getLoc t)
+ addFatalError $ PsError (PsErrInvalidDataCon (unLoc t)) [] (getLoc t)
{- Note [Ambiguous syntactic categories]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2129,7 +2129,7 @@ checkPrecP
checkPrecP (L l (_,i)) (L _ ol)
| 0 <= i, i <= maxPrecedence = pure ()
| all specialOp ol = pure ()
- | otherwise = addFatalError $ Error (ErrPrecedenceOutOfRange i) [] l
+ | otherwise = addFatalError $ PsError (PsErrPrecedenceOutOfRange i) [] l
where
-- If you change this, consider updating Note [Fixity of (->)] in GHC/Types.hs
specialOp op = unLoc op `elem` [ eqTyCon_RDR
@@ -2145,7 +2145,7 @@ mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd)
| isRdrDataCon c
= return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
mkRecConstrOrUpdate exp _ (fs,dd)
- | Just dd_loc <- dd = addFatalError $ Error ErrDotsInRecordUpdate [] dd_loc
+ | Just dd_loc <- dd = addFatalError $ PsError PsErrDotsInRecordUpdate [] dd_loc
| otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
@@ -2209,7 +2209,7 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
mkCImport = do
let e = unpackFS entity
case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of
- Nothing -> addFatalError $ Error ErrMalformedEntityString [] loc
+ Nothing -> addFatalError $ PsError PsErrMalformedEntityString [] loc
Just importSpec -> returnSpec importSpec
-- currently, all the other import conventions only support a symbol name in
@@ -2347,12 +2347,12 @@ mkModuleImpExp (L l specname) subs =
in (\newName
-> IEThingWith noExtField (L l newName) pos ies [])
<$> nameT
- else addFatalError $ Error ErrIllegalPatSynExport [] l
+ else addFatalError $ PsError PsErrIllegalPatSynExport [] l
where
name = ieNameVal specname
nameT =
if isVarNameSpace (rdrNameSpace name)
- then addFatalError $ Error (ErrVarForTyCon name) [] l
+ then addFatalError $ PsError (PsErrVarForTyCon name) [] l
else return $ ieNameFromSpec specname
ieNameVal (ImpExpQcName ln) = unLoc ln
@@ -2369,7 +2369,7 @@ mkTypeImpExp :: Located RdrName -- TcCls or Var name space
-> P (Located RdrName)
mkTypeImpExp name =
do allowed <- getBit ExplicitNamespacesBit
- unless allowed $ addError $ Error ErrIllegalExplicitNamespace [] (getLoc name)
+ unless allowed $ addError $ PsError PsErrIllegalExplicitNamespace [] (getLoc name)
return (fmap (`setRdrNameSpace` tcClsName) name)
checkImportSpec :: Located [LIE GhcPs] -> P (Located [LIE GhcPs])
@@ -2379,7 +2379,7 @@ checkImportSpec ie@(L _ specs) =
(l:_) -> importSpecError l
where
importSpecError l =
- addFatalError $ Error ErrIllegalImportBundleForm [] l
+ addFatalError $ PsError PsErrIllegalImportBundleForm [] l
-- In the correct order
mkImpExpSubSpec :: [Located ImpExpQcSpec] -> P ([AddAnn], ImpExpSubSpec)
@@ -2400,21 +2400,21 @@ isImpExpQcWildcard _ = False
warnPrepositiveQualifiedModule :: SrcSpan -> P ()
warnPrepositiveQualifiedModule span =
- addWarning Opt_WarnPrepositiveQualifiedModule (WarnImportPreQualified span)
+ addWarning Opt_WarnPrepositiveQualifiedModule (PsWarnImportPreQualified span)
failOpNotEnabledImportQualifiedPost :: SrcSpan -> P ()
-failOpNotEnabledImportQualifiedPost loc = addError $ Error ErrImportPostQualified [] loc
+failOpNotEnabledImportQualifiedPost loc = addError $ PsError PsErrImportPostQualified [] loc
failOpImportQualifiedTwice :: SrcSpan -> P ()
-failOpImportQualifiedTwice loc = addError $ Error ErrImportQualifiedTwice [] loc
+failOpImportQualifiedTwice loc = addError $ PsError PsErrImportQualifiedTwice [] loc
warnStarIsType :: SrcSpan -> P ()
-warnStarIsType span = addWarning Opt_WarnStarIsType (WarnStarIsType span)
+warnStarIsType span = addWarning Opt_WarnStarIsType (PsWarnStarIsType span)
failOpFewArgs :: MonadP m => Located RdrName -> m a
failOpFewArgs (L loc op) =
do { star_is_type <- getBit StarIsTypeBit
- ; addFatalError $ Error (ErrOpFewArgs (StarIsType star_is_type) op) [] loc }
+ ; addFatalError $ PsError (PsErrOpFewArgs (StarIsType star_is_type) op) [] loc }
-----------------------------------------------------------------------------
-- Misc utils
@@ -2427,8 +2427,8 @@ data PV_Context =
data PV_Accum =
PV_Accum
- { pv_warnings :: Bag Warning
- , pv_errors :: Bag Error
+ { pv_warnings :: Bag PsWarning
+ , pv_errors :: Bag PsError
, pv_annotations :: [(ApiAnnKey,[RealSrcSpan])]
, pv_comment_q :: [RealLocated AnnotationComment]
, pv_annotations_comments :: [(RealSrcSpan,[RealLocated AnnotationComment])]
@@ -2503,10 +2503,10 @@ add_hint hint m =
PV (\ctx acc -> unPV m (modifyHint ctx) acc)
instance MonadP PV where
- addError err@(Error e hints loc) =
+ addError err@(PsError e hints loc) =
PV $ \ctx acc ->
let err' | null (pv_hints ctx) = err
- | otherwise = Error e (hints ++ pv_hints ctx) loc
+ | otherwise = PsError e (hints ++ pv_hints ctx) loc
in PV_Ok acc{pv_errors = err' `consBag` pv_errors acc} ()
addWarning option w =
PV $ \ctx acc ->
@@ -2580,7 +2580,7 @@ hintBangPat :: SrcSpan -> Pat GhcPs -> PV ()
hintBangPat span e = do
bang_on <- getBit BangPatBit
unless bang_on $
- addError $ Error (ErrIllegalBangPattern e) [] span
+ addError $ PsError (PsErrIllegalBangPattern e) [] span
mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExpr GhcPs)
@@ -2595,7 +2595,7 @@ mkSumOrTupleExpr l boxity (Tuple es) =
mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
return $ L l (ExplicitSum noExtField alt arity e)
mkSumOrTupleExpr l Boxed a at Sum{} =
- addFatalError $ Error (ErrUnsupportedBoxedSumExpr a) [] l
+ addFatalError $ PsError (PsErrUnsupportedBoxedSumExpr a) [] l
mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Located (PatBuilder GhcPs))
@@ -2606,7 +2606,7 @@ mkSumOrTuplePat l boxity (Tuple ps) = do
where
toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)
toTupPat (L l p) = case p of
- Nothing -> addFatalError $ Error ErrTupleSectionInPat [] l
+ Nothing -> addFatalError $ PsError PsErrTupleSectionInPat [] l
Just p' -> checkLPat p'
-- Sum
@@ -2614,7 +2614,7 @@ mkSumOrTuplePat l Unboxed (Sum alt arity p) = do
p' <- checkLPat p
return $ L l (PatBuilderPat (SumPat noExtField p' alt arity))
mkSumOrTuplePat l Boxed a at Sum{} =
- addFatalError $ Error (ErrUnsupportedBoxedSumPat a) [] l
+ addFatalError $ PsError (PsErrUnsupportedBoxedSumPat a) [] l
mkLHsOpTy :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> LHsType GhcPs
mkLHsOpTy x op y =
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -192,9 +192,9 @@ addHaddockToModule lmod = do
reportHdkWarning :: HdkWarn -> P ()
reportHdkWarning (HdkWarnInvalidComment (L l _)) =
- addWarning Opt_WarnInvalidHaddock $ WarnHaddockInvalidPos (mkSrcSpanPs l)
+ addWarning Opt_WarnInvalidHaddock $ PsWarnHaddockInvalidPos (mkSrcSpanPs l)
reportHdkWarning (HdkWarnExtraComment (L l _)) =
- addWarning Opt_WarnInvalidHaddock $ WarnHaddockIgnoreMulti l
+ addWarning Opt_WarnInvalidHaddock $ PsWarnHaddockIgnoreMulti l
collectHdkWarnings :: HdkSt -> [HdkWarn]
collectHdkWarnings HdkSt{ hdk_st_pending, hdk_st_warnings } =
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d66b4bcd383867368172c82fc92fa150a4988b23
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d66b4bcd383867368172c82fc92fa150a4988b23
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201218/ad4e6296/attachment-0001.html>
More information about the ghc-commits
mailing list