Fixed warnings in main/ErrUtils
[ghc-hetmet.git] / compiler / main / ErrUtils.lhs
index 8b3af12..0b61295 100644 (file)
@@ -27,9 +27,10 @@ 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 Module          ( ModLocation(..))
 import Bag             ( Bag, bagToList, isEmptyBag, emptyBag )
 import SrcLoc          ( SrcSpan )
 import Util            ( sortLe )
@@ -84,7 +85,7 @@ errMsgTc :: TyCon
 errMsgTc = mkTyCon "ErrMsg"
 {-# NOINLINE errMsgTc #-}
 instance Typeable ErrMsg where
-#if __GLASGOW_HASKELL__ < 603
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
   typeOf _ = mkAppTy errMsgTc []
 #else
   typeOf _ = mkTyConApp errMsgTc []
@@ -138,7 +139,7 @@ printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
 printBagOfErrors dflags bag_of_errors
   = sequence_   [ let style = mkErrStyle unqual
                  in log_action dflags SevError s style (d $$ e)
-               | ErrMsg { errMsgSpans = s:ss,
+               | ErrMsg { errMsgSpans = s:_,
                           errMsgShortDoc = d,
                           errMsgExtraInfo = e,
                           errMsgContext = unqual } <- sorted_errs ]
@@ -156,7 +157,7 @@ printBagOfWarnings :: DynFlags -> Bag ErrMsg -> IO ()
 printBagOfWarnings dflags bag_of_warns
   = sequence_   [ let style = mkErrStyle unqual
                  in log_action dflags SevWarning s style (d $$ e)
-               | ErrMsg { errMsgSpans = s:ss,
+               | ErrMsg { errMsgSpans = s:_,
                           errMsgShortDoc = d,
                           errMsgExtraInfo = e,
                           errMsgContext = unqual } <- sorted_errs ]
@@ -216,6 +217,7 @@ dumpIfSet_dyn_or dflags flags hdr doc
   = printDump (mkDumpDoc hdr doc)
   | otherwise = return ()
 
+mkDumpDoc :: String -> SDoc -> SDoc
 mkDumpDoc hdr doc 
    = vcat [text "", 
           line <+> text hdr <+> line,