setMsgHandler,
-- * Targets
- Target(..), TargetId(..),
+ Target(..), TargetId(..), Phase,
setTargets,
getTargets,
addTarget,
modInfoTopLevelScope,
modInfoPrintUnqualified,
modInfoExports,
+ modInfoInstances,
+ modInfoIsExportedName,
+ modInfoLookupName,
lookupGlobalName,
-- * Interactive evaluation
Module, mkModule, pprModule,
-- ** Names
- Name,
+ Name, nameModule,
-- ** Identifiers
Id, idType,
Class,
classSCTheta, classTvsFds,
+ -- ** Instances
+ Instance,
+
-- ** Types and Kinds
Type, dropForAlls,
Kind,
#endif
import Packages ( initPackages )
-import NameSet ( NameSet, nameSetToList )
+import NameSet ( NameSet, nameSetToList, elemNameSet )
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
globalRdrEnvElts )
import HsSyn
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
import Class ( Class, classSCTheta, classTvsFds )
import DataCon ( DataCon )
-import Name ( Name )
+import Name ( Name, nameModule )
import NameEnv ( nameEnvElts )
+import InstEnv ( Instance )
import SrcLoc ( Located(..) )
import DriverPipeline
import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
-- then use that
-- - otherwise interpret the string as a module name
--
-guessTarget :: String -> IO Target
-guessTarget file
+guessTarget :: String -> Maybe Phase -> IO Target
+guessTarget file (Just phase)
+ = return (Target (TargetFile file (Just phase)) Nothing)
+guessTarget file Nothing
| isHaskellSrcFilename file
- = return (Target (TargetFile file) Nothing)
+ = return (Target (TargetFile file Nothing) Nothing)
| otherwise
= do exists <- doesFileExist hs_file
- if exists then return (Target (TargetFile hs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile hs_file Nothing) Nothing)
+ else do
exists <- doesFileExist lhs_file
- if exists then return (Target (TargetFile lhs_file) Nothing) else do
+ if exists
+ then return (Target (TargetFile lhs_file Nothing) Nothing)
+ else do
return (Target (TargetModule (mkModule file)) Nothing)
where
- hs_file = file ++ ".hs"
- lhs_file = file ++ ".lhs"
+ hs_file = file `joinFileExt` "hs"
+ lhs_file = file `joinFileExt` "lhs"
-- -----------------------------------------------------------------------------
-- Loading the program
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
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_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,
old_summary_map = mkNodeMap old_summaries
getRootSummary :: Target -> IO ModSummary
- getRootSummary (Target (TargetFile file) maybe_buf)
+ getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
= do exists <- doesFileExist file
if exists
- then summariseFile hsc_env old_summaries file maybe_buf
- else do
+ then summariseFile hsc_env old_summaries file mb_phase maybe_buf
+ else do
throwDyn (CmdLineError ("can't find file: " ++ file))
getRootSummary (Target (TargetModule modl) maybe_buf)
- = do maybe_summary <- summariseModule hsc_env emptyNodeMap Nothing False
+ = do maybe_summary <- summariseModule hsc_env old_summary_map Nothing False
modl maybe_buf excl_mods
case maybe_summary of
Nothing -> packageModErr modl
:: HscEnv
-> [ModSummary] -- old summaries
-> FilePath -- source file name
+ -> Maybe Phase -- start phase
-> Maybe (StringBuffer,ClockTime)
-> IO ModSummary
-summariseFile hsc_env old_summaries file maybe_buf
+summariseFile hsc_env old_summaries file mb_phase maybe_buf
-- we can use a cached summary if one is available and the
-- source file hasn't changed, But we have to look up the summary
-- by source file, rather than module name as we do in summarise.
let dflags = hsc_dflags hsc_env
(dflags', hspp_fn, buf)
- <- preprocessFile dflags file maybe_buf
+ <- preprocessFile dflags file mb_phase maybe_buf
(srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
= do
-- Preprocess the source file and get its imports
-- The dflags' contains the OPTIONS pragmas
- (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
+ (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
(srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
when (mod_name /= wanted_mod) $
else modificationTimeIfExists (ml_obj_file location)
-preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
+preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn Nothing
+preprocessFile dflags src_fn mb_phase Nothing
= do
- (dflags', hspp_fn) <- preprocess dflags src_fn
+ (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
buf <- hGetStringBuffer hspp_fn
return (dflags', hspp_fn, buf)
-preprocessFile dflags src_fn (Just (buf, time))
+preprocessFile dflags src_fn mb_phase (Just (buf, time))
= do
-- case we bypass the preprocessing stage?
let
let
needs_preprocessing
- | Unlit _ <- startPhase src_fn = True
+ | Just (Unlit _) <- mb_phase = True
+ | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
-- note: local_opts is only required if there's no Unlit phase
| dopt Opt_Cpp dflags' = True
| dopt Opt_Pp dflags' = True
-- | Container for information about a 'Module'.
data ModuleInfo = ModuleInfo {
- minf_type_env :: TypeEnv,
- minf_exports :: NameSet,
- minf_rdr_env :: Maybe GlobalRdrEnv
- }
+ minf_type_env :: TypeEnv,
+ minf_exports :: NameSet,
+ minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
+ minf_instances :: [Instance]
-- ToDo: this should really contain the ModIface too
+ }
-- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too.
Just ty <- [lookupTypeEnv pte name] ]
--
return (Just (ModuleInfo {
- minf_type_env = mkTypeEnv tys,
- minf_exports = names,
- minf_rdr_env = Just $! nameSetToGlobalRdrEnv names mdl
+ minf_type_env = mkTypeEnv tys,
+ minf_exports = names,
+ minf_rdr_env = Just $! nameSetToGlobalRdrEnv names mdl,
+ minf_instances = error "getModuleInfo: instances for package module unimplemented"
}))
#else
-- bogusly different for non-GHCI (ToDo)
Just hmi ->
let details = hm_details hmi in
return (Just (ModuleInfo {
- minf_type_env = md_types details,
- minf_exports = md_exports details,
- minf_rdr_env = mi_globals $! hm_iface hmi
+ minf_type_env = md_types details,
+ minf_exports = md_exports details,
+ minf_rdr_env = mi_globals $! hm_iface hmi,
+ minf_instances = md_insts details
}))
-- ToDo: we should be able to call getModuleInfo on a package module,
modInfoExports :: ModuleInfo -> [Name]
modInfoExports minf = nameSetToList $! minf_exports minf
+-- | Returns the instances defined by the specified module.
+-- Warning: currently unimplemented for package modules.
+modInfoInstances :: ModuleInfo -> [Instance]
+modInfoInstances = minf_instances
+
+modInfoIsExportedName :: ModuleInfo -> Name -> Bool
+modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
+
modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)
+modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
+modInfoLookupName s minf name = withSession s $ \hsc_env -> do
+ case lookupTypeEnv (minf_type_env minf) name of
+ Just tyThing -> return (Just tyThing)
+ Nothing -> do
+ eps <- readIORef (hsc_EPS hsc_env)
+ return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
+
isDictonaryId :: Id -> Bool
isDictonaryId id
= case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
projects / ghc-hetmet.git / blobdiff