X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=22f645efd562e4ac60708823a579ba15675994d5;hb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;hp=26c854b3a7f8f069a0dae2b40d23fb17f82ae098;hpb=e761a777f2440ca1b8d8b40848cc5aa30d889ff6;p=ghc-hetmet.git

diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index 26c854b..22f645e 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -40,7 +40,7 @@ import Panic
 import Maybes
 import Bag		( emptyBag, listToBag )
 
-import Control.Exception
+import Exception
 import Control.Monad
 import System.Exit
 import System.IO
@@ -61,8 +61,9 @@ getImports dflags buf filename source_filename = do
 	      let
                 main_loc = mkSrcLoc (mkFastString source_filename) 1 0
 		mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
-	        (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
-		source_imps   = map getImpMod src_idecls	
+                imps' = filter isHomeImp (map unLoc imps)
+	        (src_idecls, ord_idecls) = partition isSourceIdecl imps'
+		source_imps   = map getImpMod src_idecls
 		ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc) 
 					(map getImpMod ord_idecls)
 		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
@@ -70,13 +71,18 @@ getImports dflags buf filename source_filename = do
 	      return (source_imps, ordinary_imps, mod)
   
 parseError :: SrcSpan -> Message -> a
-parseError span err = throwDyn $ mkPlainErrMsg span err
+parseError span err = throwErrMsg $ mkPlainErrMsg span err
+
+-- we aren't interested in package imports here, filter them out
+isHomeImp :: ImportDecl name -> Bool
+isHomeImp (ImportDecl _ (Just p) _ _ _ _) = p == fsLit "this"
+isHomeImp (ImportDecl _ Nothing  _ _ _ _) = True
 
 isSourceIdecl :: ImportDecl name -> Bool
-isSourceIdecl (ImportDecl _ s _ _ _) = s
+isSourceIdecl (ImportDecl _ _ s _ _ _) = s
 
 getImpMod :: ImportDecl name -> Located ModuleName
-getImpMod (ImportDecl located_mod _ _ _ _) = located_mod
+getImpMod (ImportDecl located_mod _ _ _ _ _) = located_mod
 
 --------------------------------------------------------------
 -- Get options
@@ -87,7 +93,7 @@ getOptionsFromFile :: DynFlags
                    -> FilePath            -- input file
                    -> IO [Located String] -- options, if any
 getOptionsFromFile dflags filename
-    = Control.Exception.bracket
+    = Exception.bracket
 	      (openBinaryFile filename ReadMode)
               (hClose)
               (\handle ->
@@ -179,13 +185,14 @@ getOptions' dflags buf filename
 -----------------------------------------------------------------------------
 -- Complain about non-dynamic flags in OPTIONS pragmas
 
-checkProcessArgsResult :: [String] -> FilePath -> IO ()
-checkProcessArgsResult flags filename
-  = do when (notNull flags) (throwDyn (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)
 
 -----------------------------------------------------------------------------