X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=eea6b52fc21a1357baf6e8d917d46842711b5e87;hb=1867a7bb8c59ea514b4f47f5434842543933ec9a;hp=26c854b3a7f8f069a0dae2b40d23fb17f82ae098;hpb=e761a777f2440ca1b8d8b40848cc5aa30d889ff6;p=ghc-hetmet.git diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 26c854b..eea6b52 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 -> @@ -181,7 +187,7 @@ getOptions' dflags buf filename checkProcessArgsResult :: [String] -> FilePath -> IO () checkProcessArgsResult flags filename - = do when (notNull flags) (throwDyn (ProgramError ( + = do when (notNull flags) (ghcError (ProgramError ( showSDoc (hang (text filename <> char ':') 4 (text "unknown flags in {-# OPTIONS #-} pragma:" <+> hsep (map text flags)))