[project @ 2004-08-13 13:04:50 by simonmar]

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

diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
index 358c7ab..3a53644 100644 (file)
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -30,7 +30,7 @@ import SrcLoc         ( srcSpanStart )
 import CmdLineOpts     ( DynFlags(..), DynFlag(..), dopt,
                          opt_ErrorSpans )
 
-import List             ( replicate )
+import List             ( replicate, sortBy )
 import System          ( ExitCode(..), exitWith )
 import IO              ( hPutStr, stderr, stdout )
 
@@ -120,9 +120,12 @@ printErrorsAndWarnings (warns, errs)
 
 pprBagOfErrors :: Bag ErrMsg -> Pretty.Doc
 pprBagOfErrors bag_of_errors
-  = Pretty.vcat [ let style = mkErrStyle unqual in
-                 Pretty.text "" Pretty.$$ d style Pretty.$$ e style
-               | ErrMsg { errMsgShortDoc = d,
+  = Pretty.vcat [ let style = mkErrStyle unqual
+                     doc = mkLocMessage s (d $$ e)
+                 in
+                 Pretty.text "" Pretty.$$ doc style
+               | ErrMsg { errMsgSpans = s:ss,
+                          errMsgShortDoc = d,
                           errMsgExtraInfo = e,
                           errMsgContext = unqual } <- sorted_errs ]
     where
@@ -130,7 +133,7 @@ pprBagOfErrors bag_of_errors
       sorted_errs = sortLt occ'ed_before bag_ls
 
       occ'ed_before err1 err2 = 
-         LT == compare (head (errMsgSpans err1)) (head (errMsgSpans err1))
+         LT == compare (head (errMsgSpans err1)) (head (errMsgSpans err2))
 
 pprBagOfWarnings :: Bag WarnMsg -> Pretty.Doc
 pprBagOfWarnings bag_of_warns = pprBagOfErrors bag_of_warns
@@ -175,9 +178,7 @@ dumpIfSet_core dflags flag hdr doc
 dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
 dumpIfSet_dyn dflags flag hdr doc
   | dopt flag dflags || verbosity dflags >= 4 
-  = if   flag `elem` [Opt_D_dump_stix, Opt_D_dump_asm]
-    then printForC stdout (mkDumpDoc hdr doc)
-    else printDump (mkDumpDoc hdr doc)
+  = printDump (mkDumpDoc hdr doc)
   | otherwise
   = return ()