+-- -----------------------------------------------------------------------------
+-- Check module
+
+data CheckedModule =
+ CheckedModule { parsedSource :: ParsedSource,
+ renamedSource :: Maybe RenamedSource,
+ typecheckedSource :: Maybe TypecheckedSource,
+ checkedModuleInfo :: Maybe ModuleInfo
+ }
+ -- ToDo: improvements that could be made here:
+ -- if the module succeeded renaming but not typechecking,
+ -- we can still get back the GlobalRdrEnv and exports, so
+ -- perhaps the ModuleInfo should be split up into separate
+ -- fields within CheckedModule.
+
+type ParsedSource = Located (HsModule RdrName)
+type RenamedSource = HsGroup Name
+type TypecheckedSource = LHsBinds Id
+
+-- NOTE:
+-- - things that aren't in the output of the renamer:
+-- - the export list
+-- - the imports
+-- - things that aren't in the output of the typechecker right now:
+-- - the export list
+-- - the imports
+-- - type signatures
+-- - type/data/newtype declarations
+-- - class declarations
+-- - instances
+-- - extra things in the typechecker's output:
+-- - default methods are turned into top-level decls.
+-- - dictionary bindings
+
+
+-- | This is the way to get access to parsed and typechecked source code
+-- for a module. 'checkModule' loads all the dependencies of the specified
+-- module in the Session, and then attempts to typecheck the module. If
+-- successful, it returns the abstract syntax for the module.
+checkModule :: Session -> Module -> IO (Maybe CheckedModule)
+checkModule session@(Session ref) mod = do
+ -- load up the dependencies first
+ r <- load session (LoadDependenciesOf mod)
+ if (failed r) then return Nothing else do
+
+ -- now parse & typecheck the module
+ hsc_env <- readIORef ref
+ let mg = hsc_mod_graph hsc_env
+ case [ ms | ms <- mg, ms_mod ms == mod ] of
+ [] -> return Nothing
+ (ms:_) -> do
+ -- Add in the OPTIONS from the source file This is nasty:
+ -- we've done this once already, in the compilation manager
+ -- It might be better to cache the flags in the
+ -- ml_hspp_file field, say
+ let dflags0 = hsc_dflags hsc_env
+ hspp_buf = expectJust "GHC.checkModule" (ms_hspp_buf ms)
+ filename = fromJust (ml_hs_file (ms_location ms))
+ opts = getOptionsFromStringBuffer hspp_buf filename
+ (dflags1,leftovers) <- parseDynamicFlags dflags0 (map snd opts)
+ if (not (null leftovers))
+ then do printErrorsAndWarnings dflags1 (optionsErrorMsgs leftovers opts filename)
+ return Nothing
+ else do
+
+ r <- hscFileCheck hsc_env{hsc_dflags=dflags1} ms
+ case r of
+ HscFail ->
+ return Nothing
+ HscChecked parsed renamed Nothing ->
+ return (Just (CheckedModule {
+ parsedSource = parsed,
+ renamedSource = renamed,
+ typecheckedSource = Nothing,
+ checkedModuleInfo = Nothing }))
+ HscChecked parsed renamed
+ (Just (tc_binds, rdr_env, details)) -> do
+ let minf = ModuleInfo {
+ minf_type_env = md_types details,
+ minf_exports = md_exports details,
+ minf_rdr_env = Just rdr_env,
+ minf_instances = md_insts details
+ }
+ return (Just (CheckedModule {
+ parsedSource = parsed,
+ renamedSource = renamed,
+ typecheckedSource = Just tc_binds,
+ checkedModuleInfo = Just minf }))
+ _other ->
+ panic "checkModule"
+
+-- ---------------------------------------------------------------------------