X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHeaderInfo.hs;h=22f645efd562e4ac60708823a579ba15675994d5;hb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;hp=dc061ba553bdc3497a20e8e3339a617cafa262db;hpb=aa9a4f1053d3c554629a2ec25955e7530c95b892;p=ghc-hetmet.git diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index dc061ba..22f645e 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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 @@ -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) (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) -----------------------------------------------------------------------------