summaryrefslogtreecommitdiff
path: root/compiler/main/GHC.hs
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-02-16 03:38:21 +0300
committerVladislav Zavialov <vlad.z.4096@gmail.com>2019-02-16 13:32:03 +0300
commit60eb2fba1d31ca3bb1dea34c019c42db5340cb44 (patch)
treeeaf29330ee272a90b7f2ed9a8eb4dbf1284e9a17 /compiler/main/GHC.hs
parent5544f6082d6e15d305b83f27f4daa29576d3666e (diff)
downloadhaskell-wip/parse-errors.tar.gz
Fix warnings and fatal parsing errorswip/parse-errors
Diffstat (limited to 'compiler/main/GHC.hs')
-rw-r--r--compiler/main/GHC.hs16
1 files changed, 8 insertions, 8 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index a1cc4a7cb6..9e58f356f6 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -337,7 +337,7 @@ import Annotations
import Module
import Panic
import Platform
-import Bag ( listToBag, unitBag )
+import Bag ( listToBag )
import ErrUtils
import MonadUtils
import Util
@@ -1363,9 +1363,9 @@ getTokenStream mod = do
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
case lexTokenStream source startLoc flags of
POk _ ts -> return ts
- PFailed _ span err ->
+ PFailed pst ->
do dflags <- getDynFlags
- liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
+ throwErrors (getErrorMessages pst dflags)
-- | Give even more information on the source than 'getTokenStream'
-- This function allows reconstructing the source completely with
@@ -1376,9 +1376,9 @@ getRichTokenStream mod = do
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
case lexTokenStream source startLoc flags of
POk _ ts -> return $ addSourceToTokens startLoc source ts
- PFailed _ span err ->
+ PFailed pst ->
do dflags <- getDynFlags
- liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
+ throwErrors (getErrorMessages pst dflags)
-- | Given a source location and a StringBuffer corresponding to this
-- location, return a rich token stream with the source associated to the
@@ -1553,9 +1553,9 @@ parser str dflags filename =
in
case unP Parser.parseModule (mkPState dflags buf loc) of
- PFailed warnFn span err ->
- let (warns,_) = warnFn dflags in
- (warns, Left $ unitBag (mkPlainErrMsg dflags span err))
+ PFailed pst ->
+ let (warns,errs) = getMessages pst dflags in
+ (warns, Left errs)
POk pst rdr_module ->
let (warns,_) = getMessages pst dflags in