depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
workingDirectoryChanged,
- checkModule, CheckedModule(..),
+ checkModule, checkAndLoadModule, CheckedModule(..),
TypecheckedSource, ParsedSource, RenamedSource,
- compileToCore,
+ compileToCore, compileToCoreModule,
-- * Parsing Haddock comments
parseHaddockComment,
setContext, getContext,
getNamesInScope,
getRdrNamesInScope,
+ getGRE,
moduleIsInterpreted,
getInfo,
exprType,
InteractiveEval.forward,
showModule,
isModuleInterpreted,
- compileExpr, HValue, dynCompileExpr,
+ InteractiveEval.compileExpr, HValue, dynCompileExpr,
lookupName,
GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
modInfoModBreaks,
instanceDFunId, pprInstance, pprInstanceHdr,
-- ** Types and Kinds
- Type, dropForAlls, splitForAllTys, funResultTy,
- pprParendType, pprTypeApp,
+ Type, splitForAllTys, funResultTy,
+ pprParendType, pprTypeApp,
Kind,
PredType,
ThetaType, pprThetaArrow,
#endif
import TcIface
+import TcRnTypes hiding (LIE)
import TcRnMonad ( initIfaceCheck )
import Packages
import NameSet
import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
import HeaderInfo ( getImports, getOptions )
import Finder
-import HscMain ( newHscEnv, hscFileCheck, HscChecked(..) )
+import HscMain
import HscTypes
import DynFlags
import StaticFlags
import UniqFM
import UniqSet
import Unique
-import PackageConfig
import FiniteMap
import Panic
import Digraph
-- | Starts a new session. A session consists of a set of loaded
-- modules, a set of options (DynFlags), and an interactive context.
+-- ToDo: explain argument [[mb_top_dir]]
newSession :: Maybe FilePath -> IO Session
newSession mb_top_dir = do
-- catch ^C
-- Parsing Haddock comments
parseHaddockComment :: String -> Either String (HsDoc RdrName)
-parseHaddockComment string = parseHaddockParagraphs (tokenise string)
+parseHaddockComment string =
+ case parseHaddockParagraphs (tokenise string) of
+ MyLeft x -> Left x
+ MyRight x -> Right x
-- -----------------------------------------------------------------------------
-- Loading the program
renamedSource :: Maybe RenamedSource,
typecheckedSource :: Maybe TypecheckedSource,
checkedModuleInfo :: Maybe ModuleInfo,
- coreBinds :: Maybe [CoreBind]
+ coreModule :: Maybe CoreModule
}
-- ToDo: improvements that could be made here:
-- if the module succeeded renaming but not typechecking,
-- If compileToCore is true, it also desugars the module and returns the
-- resulting Core bindings as a component of the CheckedModule.
checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
-checkModule (Session ref) mod compileToCore = do
- -- parse & typecheck the module
+checkModule (Session ref) mod compile_to_core
+ = do
hsc_env <- readIORef ref
let mg = hsc_mod_graph hsc_env
case [ ms | ms <- mg, ms_mod_name ms == mod ] of
[] -> return Nothing
- (ms:_) -> do
- mbChecked <- hscFileCheck
- hsc_env{hsc_dflags=ms_hspp_opts ms}
- ms compileToCore
- case mbChecked of
+ (ms:_) -> checkModule_ ref ms compile_to_core False
+
+-- | parses and typechecks a module, optionally generates Core, and also
+-- loads the module into the 'Session' so that modules which depend on
+-- this one may subsequently be typechecked using 'checkModule' or
+-- 'checkAndLoadModule'. If you need to check more than one module,
+-- you probably want to use 'checkAndLoadModule'. Constructing the
+-- interface takes a little work, so it might be slightly slower than
+-- 'checkModule'.
+checkAndLoadModule :: Session -> ModSummary -> Bool -> IO (Maybe CheckedModule)
+checkAndLoadModule (Session ref) ms compile_to_core
+ = checkModule_ ref ms compile_to_core True
+
+checkModule_ :: IORef HscEnv -> ModSummary -> Bool -> Bool
+ -> IO (Maybe CheckedModule)
+checkModule_ ref ms compile_to_core load
+ = do
+ let mod = ms_mod_name ms
+ hsc_env0 <- readIORef ref
+ let hsc_env = hsc_env0{hsc_dflags=ms_hspp_opts ms}
+ mb_parsed <- parseFile hsc_env ms
+ case mb_parsed of
Nothing -> return Nothing
- Just (HscChecked parsed renamed Nothing _) ->
- return (Just (CheckedModule {
- parsedSource = parsed,
- renamedSource = renamed,
- typecheckedSource = Nothing,
- checkedModuleInfo = Nothing,
- coreBinds = Nothing }))
- Just (HscChecked parsed renamed
- (Just (tc_binds, rdr_env, details))
- maybeCoreBinds) -> do
+ Just rdr_module -> do
+ mb_typechecked <- typecheckRenameModule hsc_env ms rdr_module
+ case mb_typechecked of
+ Nothing -> return (Just CheckedModule {
+ parsedSource = rdr_module,
+ renamedSource = Nothing,
+ typecheckedSource = Nothing,
+ checkedModuleInfo = Nothing,
+ coreModule = Nothing })
+ Just (tcg, rn_info) -> do
+ details <- makeSimpleDetails hsc_env tcg
+
+ let tc_binds = tcg_binds tcg
+ let rdr_env = tcg_rdr_env tcg
let minf = ModuleInfo {
minf_type_env = md_types details,
minf_exports = availsToNameSet $
,minf_modBreaks = emptyModBreaks
#endif
}
+
+ mb_guts <- if compile_to_core
+ then deSugarModule hsc_env ms tcg
+ else return Nothing
+
+ let mb_core = fmap (\ mg ->
+ CoreModule { cm_module = mg_module mg,
+ cm_types = mg_types mg,
+ cm_binds = mg_binds mg })
+ mb_guts
+
+ -- If we are loading this module so that we can typecheck
+ -- dependent modules, generate an interface and stuff it
+ -- all in the HomePackageTable.
+ when load $ do
+ (iface,_) <- makeSimpleIface hsc_env Nothing tcg details
+ let mod_info = HomeModInfo {
+ hm_iface = iface,
+ hm_details = details,
+ hm_linkable = Nothing }
+ let hpt_new = addToUFM (hsc_HPT hsc_env) mod mod_info
+ writeIORef ref hsc_env0{ hsc_HPT = hpt_new }
+
return (Just (CheckedModule {
- parsedSource = parsed,
- renamedSource = renamed,
+ parsedSource = rdr_module,
+ renamedSource = rn_info,
typecheckedSource = Just tc_binds,
checkedModuleInfo = Just minf,
- coreBinds = maybeCoreBinds}))
+ coreModule = mb_core }))
-- | This is the way to get access to the Core bindings corresponding
-- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
--- desugar the module, then returns the resulting list of Core bindings if
--- successful.
-compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
-compileToCore session fn = do
+-- desugar the module, then returns the resulting Core module (consisting of
+-- the module name, type declarations, and function declarations) if
+-- successful.
+compileToCoreModule :: Session -> FilePath -> IO (Maybe CoreModule)
+compileToCoreModule session fn = do
-- First, set the target to the desired filename
target <- guessTarget fn Nothing
addTarget session target
case maybeModGraph of
Nothing -> return Nothing
Just modGraph -> do
- let modSummary = expectJust "compileToCore" $
- find ((== fn) . msHsFilePath) modGraph
- -- Now we have the module name;
- -- parse, typecheck and desugar the module
- let mod = ms_mod_name modSummary
- maybeCheckedModule <- checkModule session mod True
- case maybeCheckedModule of
+ case find ((== fn) . msHsFilePath) modGraph of
+ Just modSummary -> do
+ -- Now we have the module name;
+ -- parse, typecheck and desugar the module
+ let mod = ms_mod_name modSummary
+ maybeCheckedModule <- checkModule session mod True
+ case maybeCheckedModule of
Nothing -> return Nothing
- Just checkedMod -> return $ coreBinds checkedMod
- -- ---------------------------------------------------------------------------
+ Just checkedMod -> return $ coreModule checkedMod
+ Nothing -> panic "compileToCoreModule: target FilePath not found in\
+ module dependency graph"
+
+-- | Provided for backwards-compatibility: compileToCore returns just the Core
+-- bindings, but for most purposes, you probably want to call
+-- compileToCoreModule.
+compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
+compileToCore session fn = do
+ maybeCoreModule <- compileToCoreModule session fn
+ return $ fmap cm_binds maybeCoreModule
+-- ---------------------------------------------------------------------------
-- Unloading
unload :: HscEnv -> [Linkable] -> IO ()
cleanup -- Remove unwanted tmp files between compilations
case mb_mod_info of
- Nothing -> return (Failed, hsc_env, [])
+ Nothing -> return (Failed, hsc_env, done)
Just mod_info -> do
let this_mod = ms_mod_name mod
iface = hm_iface hm_info
compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
- compile_it = upsweep_compile hsc_env
- summary' mod_index nmods mb_old_iface
+ compile_it = compile hsc_env summary' mod_index nmods mb_old_iface
compile_it_discard_iface
- = upsweep_compile hsc_env
- summary' mod_index nmods Nothing
+ = compile hsc_env summary' mod_index nmods Nothing
in
case target of
compile_it Nothing
--- Run hsc to compile a module
-upsweep_compile :: HscEnv -> ModSummary -> Int -> Int
- -> Maybe ModIface -> Maybe Linkable -> IO (Maybe HomeModInfo)
-upsweep_compile hsc_env summary mod_index nmods mb_old_iface mb_old_linkable
- = do
- compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
- mod_index nmods
-
- case compresult of
- -- Compilation failed. Compile may still have updated the PCS, tho.
- CompErrs -> return Nothing
-
- -- Compilation "succeeded", and may or may not have returned a new
- -- linkable (depending on whether compilation was actually performed
- -- or not).
- CompOK new_details new_iface new_linkable
- -> do let new_info = HomeModInfo { hm_iface = new_iface,
- hm_details = new_details,
- hm_linkable = new_linkable }
- return (Just new_info)
-
-- Filter modules in the HPT
retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
return $! lookupType (hsc_dflags hsc_env)
(hsc_HPT hsc_env) (eps_PTE eps) name
+#ifdef GHCI
+-- | get the GlobalRdrEnv for a session
+getGRE :: Session -> IO GlobalRdrEnv
+getGRE s = withSession s $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
+#endif
+
-- -----------------------------------------------------------------------------
-- Misc exported utils