X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=daa66c7736dd96509c0cb631c865691676c6bfd0;hb=ffaa27acb9cd3b64b25aea83e5ce9540e40752bd;hp=eea6b52fc21a1357baf6e8d917d46842711b5e87;hpb=1867a7bb8c59ea514b4f47f5434842543933ec9a;p=ghc-hetmet.git

diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index eea6b52..daa66c7 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -22,6 +22,7 @@ module HeaderInfo ( getImports
 
 #include "HsVersions.h"
 
+import HscTypes
 import Parser		( parseHeader )
 import Lexer
 import FastString
@@ -70,8 +71,8 @@ getImports dflags buf filename source_filename = do
 	      in
 	      return (source_imps, ordinary_imps, mod)
   
-parseError :: SrcSpan -> Message -> a
-parseError span err = throwErrMsg $ mkPlainErrMsg span err
+parseError :: SrcSpan -> Message -> IO a
+parseError span err = throwOneError $ mkPlainErrMsg span err
 
 -- we aren't interested in package imports here, filter them out
 isHomeImp :: ImportDecl name -> Bool
@@ -185,13 +186,14 @@ getOptions' dflags buf filename
 -----------------------------------------------------------------------------
 -- Complain about non-dynamic flags in OPTIONS pragmas
 
-checkProcessArgsResult :: [String] -> FilePath -> IO ()
-checkProcessArgsResult flags filename
-  = do when (notNull flags) (ghcError (ProgramError (
-          showSDoc (hang (text filename <> char ':')
-                      4 (text "unknown flags in  {-# OPTIONS #-} pragma:" <+>
-                          hsep (map text flags)))
-        )))
+checkProcessArgsResult :: [Located String] -> IO ()
+checkProcessArgsResult flags
+  = when (notNull flags) $
+        ghcError $ ProgramError $ showSDoc $ vcat $ map f flags
+    where f (L loc flag)
+              = hang (ppr loc <> char ':') 4
+                     (text "unknown flag in  {-# OPTIONS #-} pragma:" <+>
+                      text flag)
 
 -----------------------------------------------------------------------------