Don't import FastString in HsVersions.h

[ghc-hetmet.git] / compiler / main / ErrUtils.lhs

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index 0b61295..9ce02a3 100644 (file)
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -16,7 +16,8 @@ module ErrUtils (
 
        ghcExit,
        doIfSet, doIfSet_dyn, 
-       dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, dumpSDoc,
+       dumpIfSet, dumpIf_core, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or,
+        mkDumpDoc, dumpSDoc,
 
        --  * Messages during compilation
        putMsg,
@@ -27,8 +28,6 @@ module ErrUtils (
        debugTraceMsg,  
     ) where
 
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import Bag             ( Bag, bagToList, isEmptyBag, emptyBag )
@@ -39,6 +38,7 @@ import SrcLoc         ( srcSpanStart, noSrcSpan )
 import DynFlags                ( DynFlags(..), DynFlag(..), dopt )
 import StaticFlags     ( opt_ErrorSpans )
 
+import Control.Monad
 import System.Exit     ( ExitCode(..), exitWith )
 import Data.Dynamic
 import Data.List
@@ -127,10 +127,13 @@ errorsFound dflags (warns, errs)
 
 printErrorsAndWarnings :: DynFlags -> Messages -> IO ()
 printErrorsAndWarnings dflags (warns, errs)
-  | no_errs && no_warns  = return ()
-  | no_errs             = printBagOfWarnings dflags warns
-                           -- Don't print any warnings if there are errors
-  | otherwise           = printBagOfErrors   dflags errs
+  | no_errs && no_warns = return ()
+  | no_errs             = do printBagOfWarnings dflags warns
+                             when (dopt Opt_WarnIsError dflags) $
+                                 errorMsg dflags $
+                                     text "\nFailing due to -Werror.\n"
+                          -- Don't print any warnings if there are errors
+  | otherwise           = printBagOfErrors dflags errs
   where
     no_warns = isEmptyBag warns
     no_errs  = isEmptyBag errs
@@ -195,13 +198,18 @@ dumpIfSet flag hdr doc
   | not flag   = return ()
   | otherwise  = printDump (mkDumpDoc hdr doc)
 
+dumpIf_core :: Bool -> DynFlags -> DynFlag -> String -> SDoc -> IO ()
+dumpIf_core cond dflags dflag hdr doc
+  | cond
+    || verbosity dflags >= 4
+    || dopt Opt_D_verbose_core2core dflags
+  = dumpSDoc dflags dflag hdr doc
+
+  | otherwise = return ()
+
 dumpIfSet_core :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
 dumpIfSet_core dflags flag hdr doc
-  | dopt flag dflags
-       || verbosity dflags >= 4
-       || dopt Opt_D_verbose_core2core dflags
-  = dumpSDoc dflags flag hdr doc
-  | otherwise                                   = return ()
+  = dumpIf_core (dopt flag dflags) dflags flag hdr doc
 
 dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
 dumpIfSet_dyn dflags flag hdr doc