Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
7b2ac617
Commit
7b2ac617
authored
Sep 14, 2008
by
Thomas Schilling
Browse files
Return parser errors and warnings instead of dying.
parent
46aff945
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmParse.y
View file @
7b2ac617
...
...
@@ -53,6 +53,7 @@ import FastString
import Panic
import Constants
import Outputable
import Bag ( emptyBag, unitBag )
import Control.Monad
import Data.Array
...
...
@@ -1092,7 +1093,7 @@ initEnv = listToUFM [
Var (CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) ))
]
parseCmmFile :: DynFlags -> FilePath -> IO (Maybe Cmm)
parseCmmFile :: DynFlags -> FilePath -> IO (
Messages,
Maybe Cmm)
parseCmmFile dflags filename = do
showPass dflags "ParseCmm"
buf <- hGetStringBuffer filename
...
...
@@ -1102,14 +1103,17 @@ parseCmmFile dflags filename = do
-- reset the lex_state: the Lexer monad leaves some stuff
-- in there we don't want.
case unP cmmParse init_state of
PFailed span err -> do printError span err; return Nothing
PFailed span err -> do
let msg = mkPlainErrMsg span err
return ((emptyBag, unitBag msg), Nothing)
POk pst code -> do
cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
let ms = getMessages pst
printErrorsAndWarnings dflags ms
when (errorsFound dflags ms) $ exitWith (ExitFailure 1)
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
return (Just cmm)
cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
let ms = getMessages pst
if (errorsFound dflags ms)
then return (ms, Nothing)
else do
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
return (ms, Just cmm)
where
no_module = panic "parseCmmFile: no module"
}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment