diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-16 03:38:21 +0300 |
---|---|---|
committer | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-16 13:32:03 +0300 |
commit | 60eb2fba1d31ca3bb1dea34c019c42db5340cb44 (patch) | |
tree | eaf29330ee272a90b7f2ed9a8eb4dbf1284e9a17 /compiler/main/GHC.hs | |
parent | 5544f6082d6e15d305b83f27f4daa29576d3666e (diff) | |
download | haskell-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.hs | 16 |
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 |