Commit 962aaded authored by sof's avatar sof
Browse files

[project @ 2003-10-02 19:20:59 by sof]

Extend -Werror's scope to also include the desugarer.

Note: -Werror doesn't give you the union of warnings from the renamer,
      TC and desugarer before bailing out, but one pass at a time.
parent a9190910
......@@ -32,9 +32,10 @@ import Id ( Id )
import NameEnv ( lookupNameEnv )
import VarEnv
import VarSet
import Bag ( isEmptyBag, mapBag )
import Bag ( isEmptyBag, mapBag, emptyBag )
import CoreLint ( showPass, endPass )
import ErrUtils ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings, addShortWarnLocLine )
import ErrUtils ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings,
addShortWarnLocLine, errorsFound )
import Outputable
import qualified Pretty
import UniqSupply ( mkSplitUniqSupply )
......@@ -52,7 +53,7 @@ import DATA_IOREF ( readIORef )
\begin{code}
deSugar :: HscEnv -> PersistentCompilerState
-> TcGblEnv -> IO ModGuts
-> TcGblEnv -> IO (Maybe ModGuts)
deSugar hsc_env pcs
(TcGblEnv { tcg_mod = mod,
......@@ -76,14 +77,20 @@ deSugar hsc_env pcs
= initDs dflags us lookup mod
(dsProgram binds rules fords)
warn_doc = pprBagOfWarnings (mapBag mk_warn ds_warns)
warns = mapBag mk_warn ds_warns
warn_doc = pprBagOfWarnings warns
-- Display any warnings
; doIfSet (not (isEmptyBag ds_warns))
(printErrs warn_doc)
-- if warnings are considered errors, leave.
; if errorsFound dflags (warns, emptyBag)
then return Nothing
else do {
-- Lint result if necessary
; endPass dflags "Desugar" Opt_D_dump_ds ds_binds
endPass dflags "Desugar" Opt_D_dump_ds ds_binds
-- Dump output
; doIfSet (dopt Opt_D_dump_ds dflags)
......@@ -108,8 +115,8 @@ deSugar hsc_env pcs
mg_binds = ds_binds,
mg_foreign = ds_fords }
; return mod_guts
}
; return (Just mod_guts)
}}
where
dflags = hsc_dflags hsc_env
......@@ -148,7 +155,8 @@ deSugarExpr hsc_env pcs this_mod rdr_env type_env tc_expr
; let (core_expr, ds_warns) = initDs dflags us lookup this_mod (dsExpr tc_expr)
warn_doc = pprBagOfWarnings (mapBag mk_warn ds_warns)
-- Display any warnings
-- Display any warnings
-- Note: if -Werror is used, we don't signal an error here.
; doIfSet (not (isEmptyBag ds_warns))
(printErrs warn_doc)
......
......@@ -322,9 +322,11 @@ hscFrontEnd hsc_env pcs_ch location = do {
-------------------
-- DESUGAR
-------------------
; ds_result <- _scc_ "DeSugar"
deSugar hsc_env pcs_tc tc_result
; return (Right (pcs_tc, ds_result))
; maybe_ds_result <- _scc_ "DeSugar"
deSugar hsc_env pcs_tc tc_result
; case maybe_ds_result of
Nothing -> return (Left (HscFail pcs_ch));
Just ds_result -> return (Right (pcs_tc, ds_result));
}}}}}
......
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