X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fiface%2FMkIface.lhs;h=4976e1fc8f8d5029f79c2c70d21dbbb9e8dbe5b7;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hp=285f17197dbdf2eec181d65cc01ea91e7a70133c;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 285f171..4976e1f 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -67,6 +67,7 @@ import TcType import InstEnv import FamInstEnv import TcRnMonad +import HsSyn import HscTypes import Finder import DynFlags @@ -100,7 +101,6 @@ import Control.Monad import Data.List import Data.IORef import System.FilePath -import System.Exit ( exitWith, ExitCode(..) ) \end{code} @@ -116,8 +116,9 @@ mkIface :: HscEnv -> Maybe Fingerprint -- The old fingerprint, if we have it -> ModDetails -- The trimmed, tidied interface -> ModGuts -- Usages, deprecations, etc - -> IO (ModIface, -- The new one - Bool) -- True <=> there was an old Iface, and the + -> IO (Messages, + Maybe (ModIface, -- The new one + Bool)) -- True <=> there was an old Iface, and the -- new one is identical, so no need -- to write it @@ -134,7 +135,7 @@ mkIface hsc_env maybe_old_fingerprint mod_details = mkIface_ hsc_env maybe_old_fingerprint this_mod is_boot used_names deps rdr_env fix_env warns hpc_info dir_imp_mods mod_details - + -- | make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('HscNothing'). @@ -142,8 +143,7 @@ mkIfaceTc :: HscEnv -> Maybe Fingerprint -- The old fingerprint, if we have it -> ModDetails -- gotten from mkBootModDetails, probably -> TcGblEnv -- Usages, deprecations, etc - -> IO (ModIface, - Bool) + -> IO (Messages, Maybe (ModIface, Bool)) mkIfaceTc hsc_env maybe_old_fingerprint mod_details tc_result@TcGblEnv{ tcg_mod = this_mod, tcg_src = hsc_src, @@ -214,7 +214,7 @@ mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface -> NameEnv FixItem -> Warnings -> HpcInfo -> ImportedMods -> ModDetails - -> IO (ModIface, Bool) + -> IO (Messages, Maybe (ModIface, Bool)) mkIface_ hsc_env maybe_old_fingerprint this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info dir_imp_mods @@ -305,10 +305,9 @@ mkIface_ hsc_env maybe_old_fingerprint | r <- iface_rules , isNothing (ifRuleOrph r) ] - ; when (not (isEmptyBag orph_warnings)) - (do { printErrorsAndWarnings dflags errs_and_warns -- XXX - ; when (errorsFound dflags errs_and_warns) - (exitWith (ExitFailure 1)) }) + ; if errorsFound dflags errs_and_warns + then return ( errs_and_warns, Nothing ) + else do { -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs) @@ -322,7 +321,7 @@ mkIface_ hsc_env maybe_old_fingerprint -- with the old GlobalRdrEnv (mi_globals). ; let final_iface = new_iface{ mi_globals = Just rdr_env } - ; return (final_iface, no_change_at_all) } + ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }} where r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2 @@ -1117,8 +1116,8 @@ checkDependencies hsc_env summary iface orM = foldr f (return False) where f m rest = do b <- m; if b then return True else rest - dep_missing (L _ mod) = do - find_res <- liftIO $ findImportedModule hsc_env mod Nothing + dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do + find_res <- liftIO $ findImportedModule hsc_env mod pkg case find_res of Found _ mod | pkg == this_pkg