Commit 5856c564 authored by ruperthorlick's avatar ruperthorlick Committed by Ben Gamari

Fixed error messages for RecursiveDo (#8501)

Changes in a few different places to catch several different
types of error related to RecursiveDo
Signed-off-by: ruperthorlick's avatarRupert Horlick <ruperthorlick@gmail.com>

Test Plan: Three test cases, with further tests in comments

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3271
parent b04ded8f
......@@ -2405,14 +2405,18 @@ srcParseErr options buf len
$$ ppWhen (not th_enabled && token == "$") -- #7396
(text "Perhaps you intended to use TemplateHaskell")
$$ ppWhen (token == "<-")
(text "Perhaps this statement should be within a 'do' block?")
(if mdoInLast100
then text "Perhaps you intended to use RecursiveDo"
else text "Perhaps this statement should be within a 'do' block?")
$$ ppWhen (token == "=")
(text "Perhaps you need a 'let' in a 'do' block?"
$$ text "e.g. 'let x = 5' instead of 'x = 5'")
$$ ppWhen (not ps_enabled && pattern == "pattern") -- #12429
$$ ppWhen (not ps_enabled && pattern == "pattern ") -- #12429
(text "Perhaps you intended to use PatternSynonyms")
where token = lexemeToString (offsetBytes (-len) buf) len
pattern = lexemeToString (offsetBytes (-len - 8) buf) 7
pattern = decodePrevNChars 8 buf
last100 = decodePrevNChars 100 buf
mdoInLast100 = "mdo" `isInfixOf` last100
th_enabled = extopt LangExt.TemplateHaskell options
ps_enabled = extopt LangExt.PatternSynonyms options
......
......@@ -805,8 +805,10 @@ checkLPat msg e@(L l _) = checkPat msg l e []
checkPat :: SDoc -> SrcSpan -> LHsExpr RdrName -> [LPat RdrName]
-> P (LPat RdrName)
checkPat _ loc (L l (HsVar (L _ c))) args
checkPat _ loc (L l e@(HsVar (L _ c))) args
| isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
| not (null args) && patIsRec c =
patFail (text "Perhaps you intended to use RecursiveDo") l e
checkPat msg 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)
......@@ -913,6 +915,9 @@ patFail msg loc e = parseErrorSDoc loc err
where err = text "Parse error in pattern:" <+> ppr e
$$ msg
patIsRec :: RdrName -> Bool
patIsRec e = e == mkUnqual varName (fsLit "rec")
---------------------------------------------------------------------------
-- Check Equation Syntax
......
......@@ -1856,7 +1856,8 @@ unknownNameSuggestions_ :: WhereLooking -> DynFlags
-> RdrName -> SDoc
unknownNameSuggestions_ where_look dflags global_env local_env imports tried_rdr_name =
similarNameSuggestions where_look dflags global_env local_env tried_rdr_name $$
importSuggestions where_look imports tried_rdr_name
importSuggestions where_look imports tried_rdr_name $$
extensionSuggestions tried_rdr_name
similarNameSuggestions :: WhereLooking -> DynFlags
......@@ -2087,6 +2088,13 @@ importSuggestions where_look imports rdr_name
(helpful_imports_hiding, helpful_imports_non_hiding)
= partition (imv_is_hiding . snd) helpful_imports
extensionSuggestions :: RdrName -> SDoc
extensionSuggestions rdrName
| rdrName == mkUnqual varName (fsLit "mdo") ||
rdrName == mkUnqual varName (fsLit "rec")
= text "Perhaps you meant to use RecursiveDo"
| otherwise = Outputable.empty
{-
************************************************************************
* *
......
......@@ -36,6 +36,7 @@ module StringBuffer
-- * Conversion
lexemeToString,
lexemeToFastString,
decodePrevNChars,
-- * Parsing integers
parseUnsignedInteger,
......@@ -263,6 +264,20 @@ lexemeToFastString (StringBuffer buf _ cur) len =
withForeignPtr buf $ \ptr ->
return $! mkFastStringBytes (ptr `plusPtr` cur) len
-- | Return the previous @n@ characters (or fewer if we are less than @n@
-- characters into the buffer.
decodePrevNChars :: Int -> StringBuffer -> String
decodePrevNChars n (StringBuffer buf _ cur) =
inlinePerformIO $ withForeignPtr buf $ \p0 ->
go p0 n "" (p0 `plusPtr` (cur - 1))
where
go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
go buf0 n acc p | n == 0 || buf0 >= p = return acc
go buf0 n acc p = do
p' <- utf8PrevChar p
let (c,_) = utf8DecodeChar p'
go buf0 (n - 1) (c:acc) p'
-- -----------------------------------------------------------------------------
-- Parsing integer strings in various bases
parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
......
prog011.hx:14:22: Empty 'do' block
prog011.hx:14:22: error: Empty 'do' block
This diff is collapsed.
mdofail005.hs:11:14:
mdofail005.hs:11:14: error:
parse error on input ‘<-’
Perhaps this statement should be within a 'do' block?
Perhaps you intended to use RecursiveDo
module Test where
foo :: IO ()
foo = do
rec str <- return "foo"
putStrLn str
-- Should fail
-- foo' :: IO ()
-- foo' = do
-- rec {str <- return "foo" ;
-- putStrLn str}
-- return ()
-- Should fail
-- foo'' :: IO ()
-- foo'' = do
-- rec putStrLn "test"
-- str <- return "foo"
-- putStrLn str
-- return ()
-- Should compile
-- foo'''' :: IO ()
-- foo'''' = do
-- rec <- return "foo"
-- putStrLn "test"
T8501a.hs:5:3: error:
Parse error in pattern: rec
Perhaps you intended to use RecursiveDo
module Test where
bar :: IO ()
bar = mdo
str <- return "bar"
putStrLn str
-- Should fail
-- bar' :: IO ()
-- bar' = mdo {str <- return "bar" ; putStrLn str}
T8501b.hs:5:9: error:
parse error on input ‘<-’
Perhaps you intended to use RecursiveDo
module Test where
baz :: IO ()
baz = mdo
putStrLn "baz"
-- Should fail
-- baz' :: IO ()
-- baz' = mdo
-- putStrLn "baz"
-- str <- return "test"
-- Should fail (and needs better error)
-- baz' :: IO ()
-- baz' = mdo {putStrLn "baz"}
T8501c.hs:4:7: error:
• Variable not in scope:
mdo :: (String -> IO ()) -> [Char] -> IO ()
• Perhaps you meant ‘mod’ (imported from Prelude)
Perhaps you meant to use RecursiveDo
......@@ -98,3 +98,6 @@ test('T12429', normal, compile_fail, [''])
test('T12811', normal, compile_fail, [''])
test('T13260', normal, compile_fail, [''])
test('T13414', literate, compile_fail, [''])
test('T8501a', normal, compile_fail, [''])
test('T8501b', normal, compile_fail, [''])
test('T8501c', normal, compile_fail, [''])
readFail040.hs:7:11:
readFail040.hs:7:11: error:
parse error on input ‘<-’
Perhaps this statement should be within a 'do' block?
Perhaps you intended to use RecursiveDo
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment