diff options
| -rw-r--r-- | compiler/ghci/InteractiveUI.hs | 2 | ||||
| -rw-r--r-- | compiler/iface/MkIface.lhs | 2 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 17 |
3 files changed, 14 insertions, 7 deletions
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 5c94597471..e0dd5cc17c 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -1083,7 +1083,7 @@ checkModule m = do let modl = GHC.mkModuleName m prev_context <- GHC.getContext ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do - r <- GHC.typecheckModule =<< GHC.parseModule modl + r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl io $ putStrLn (showSDoc ( case GHC.moduleInfo r of cm | Just scope <- GHC.modInfoTopLevelScope cm -> diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index bc84cf168a..1346a9a847 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -303,7 +303,7 @@ mkIface_ hsc_env maybe_old_fingerprint , isNothing (ifRuleOrph r) ] ; when (not (isEmptyBag orph_warnings)) - (do { printErrorsAndWarnings dflags errs_and_warns + (do { printErrorsAndWarnings dflags errs_and_warns -- XXX ; when (errorsFound dflags errs_and_warns) (exitWith (ExitFailure 1)) }) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index b023885f2e..f2f97d84e3 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -53,6 +53,7 @@ module GHC ( parsedSource, coreModule, compileToCoreModule, compileToCoreSimplified, compileCoreToObj, + getModSummary, -- * Parsing Haddock comments parseHaddockComment, @@ -1013,6 +1014,14 @@ type TypecheckedSource = LHsBinds Id -- - default methods are turned into top-level decls. -- - dictionary bindings +-- | Return the 'ModSummary' of a module with the given name. +-- +-- The module must be part of the module graph (see 'hsc_mod_graph' and +-- 'ModuleGraph'). If this is not the case, this function will throw an +-- 'GhcApiError'. +-- +-- Note that the module graph may contain several 'ModSummary's matching the +-- same name (for example both a @.hs@ and a @.hs-boot@). getModSummary :: GhcMonad m => ModuleName -> m ModSummary getModSummary mod = do mg <- liftM hsc_mod_graph getSession @@ -1023,9 +1032,8 @@ getModSummary mod = do -- | Parse a module. -- -- Throws a 'SourceError' on parse error. -parseModule :: GhcMonad m => ModuleName -> m ParsedModule -parseModule mod = do - ms <- getModSummary mod +parseModule :: GhcMonad m => ModSummary -> m ParsedModule +parseModule ms = do hsc_env0 <- getSession let hsc_env = hsc_env0 { hsc_dflags = ms_hspp_opts ms } rdr_module <- parseFile hsc_env ms @@ -1195,9 +1203,8 @@ compileCore simplify fn = do Just modSummary -> do -- Now we have the module name; -- parse, typecheck and desugar the module - let mod = ms_mod_name modSummary mod_guts <- coreModule `fmap` - (desugarModule =<< typecheckModule =<< parseModule mod) + (desugarModule =<< typecheckModule =<< parseModule modSummary) liftM gutsToCoreModule $ if simplify then do |