From 766b34f81d81d009f1070e297756423fbadbd421 Mon Sep 17 00:00:00 2001 From: Thomas Schilling Date: Thu, 2 Oct 2008 23:04:12 +0000 Subject: [PATCH] Let parseModule take a ModSummary like checkAndLoadModule did. To get the ModSummary for a ModuleName getModSummary can be used. It's not called find* or lookup* because it assumes that the module is in the module graph and throws an exception if it cannot be found. Overall, I'm not quite sure about the usefulness of this function since the user has no control about which filetype to grab (hs or hs-boot). --- compiler/ghci/InteractiveUI.hs | 2 +- compiler/iface/MkIface.lhs | 2 +- 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 5c94597..e0dd5cc 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 bc84cf1..1346a9a 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 b023885..f2f97d8 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 -- 1.7.10.4