diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Lexer.x | 4 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 17 |
2 files changed, 15 insertions, 6 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 1692904223..4042a9c518 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1435,8 +1435,8 @@ failMsgP msg = P $ \s -> PFailed (last_loc s) (text msg) failLocMsgP :: SrcLoc -> SrcLoc -> String -> P a failLocMsgP loc1 loc2 str = P $ \_ -> PFailed (mkSrcSpan loc1 loc2) (text str) -failSpanMsgP :: SrcSpan -> String -> P a -failSpanMsgP span msg = P $ \_ -> PFailed span (text msg) +failSpanMsgP :: SrcSpan -> SDoc -> P a +failSpanMsgP span msg = P $ \_ -> PFailed span msg extension :: (Int -> Bool) -> P Bool extension p = P $ \s -> POk s (p $! extsBitmap s) diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 3697819afb..e3bb3696bb 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -73,6 +73,7 @@ import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), DNCallSpec(..), DNKind(..), CLabelString ) import OccName ( srcDataName, varName, isDataOcc, isTcOcc, occNameString ) +import PrelNames ( forall_tv_RDR ) import SrcLoc import OrdList ( OrdList, fromOL ) import Bag ( Bag, emptyBag, snocBag, consBag, foldrBag ) @@ -401,7 +402,12 @@ tyConToDataCon loc tc | isTcOcc (rdrNameOcc tc) = return (L loc (setRdrNameSpace tc srcDataName)) | otherwise - = parseError loc (showSDoc (text "Not a constructor:" <+> quotes (ppr tc))) + = parseErrorSDoc loc (msg $$ extra) + where + msg = text "Not a data constructor:" <+> quotes (ppr tc) + extra | tc == forall_tv_RDR + = text "Perhaps you intended to use -XExistentialQuantification" + | otherwise = empty ---------------------------------------------------------------------------- -- Various Syntactic Checks @@ -770,8 +776,8 @@ checkFunBind :: SrcSpan -> P (HsBind RdrName) checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss) | isQual (unLoc fun) - = parseError (getLoc fun) ("Qualified name in function definition: " ++ - showRdrName (unLoc fun)) + = parseErrorSDoc (getLoc fun) + (ptext SLIT("Qualified name in function definition:") <+> ppr (unLoc fun)) | otherwise = do ps <- checkPatterns pats let match_span = combineSrcSpans lhs_loc rhs_span @@ -1070,5 +1076,8 @@ showRdrName :: RdrName -> String showRdrName r = showSDoc (ppr r) parseError :: SrcSpan -> String -> P a -parseError span s = failSpanMsgP span s +parseError span s = parseErrorSDoc span (text s) + +parseErrorSDoc :: SrcSpan -> SDoc -> P a +parseErrorSDoc span s = failSpanMsgP span s \end{code} |