\begin{code}
module HscTypes (
HscEnv(..), hscEPS,
- GhciMode(..), isOneShot,
ModDetails(..),
ModGuts(..), ModImports(..), ForeignStubs(..),
+ ModSummary(..), showModMsg, isBootSummary,
+ msHsFilePath, msHiFilePath, msObjFilePath,
+
+ HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
+
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
+ hptInstances, hptRules,
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
icPrintUnqual, unQualInScope,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
- IfacePackage(..), emptyIfaceDepCache,
+ emptyIfaceDepCache,
Deprecs(..), IfaceDeprecs,
import Class ( Class, classSelIds, classTyCon )
import TyCon ( TyCon, tyConSelIds, tyConDataCons )
import DataCon ( dataConImplicitIds )
-import Packages ( PackageId )
-import CmdLineOpts ( DynFlags )
-
+import Packages ( PackageIdH, PackageId )
+import DynFlags ( DynFlags(..), isOneShot )
+import DriverPhases ( HscSource(..), isHsBoot, hscSourceString )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
import FiniteMap ( FiniteMap )
import CoreSyn ( IdCoreRule )
-import Maybes ( orElse )
+import Maybes ( orElse, fromJust, expectJust )
import Outputable
import SrcLoc ( SrcSpan )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
import DATA_IOREF ( IORef, readIORef )
+import StringBuffer ( StringBuffer )
import Time ( ClockTime )
\end{code}
\begin{code}
data HscEnv
- = HscEnv { hsc_mode :: GhciMode,
- hsc_dflags :: DynFlags,
+ = HscEnv { hsc_dflags :: DynFlags,
hsc_HPT :: HomePackageTable,
-- The home package table describes already-compiled
-- hsc_HPT is not mutable because we only demand-load
-- external packages; the home package is eagerly
-- loaded, module by module, by the compilation manager.
+ --
+ -- The HPT may contain modules compiled earlier by --make
+ -- but not actually below the current module in the dependency
+ -- graph. (This changes a previous invariant: changed Jan 05.)
-- The next two are side-effected by compiling
-- to reflect sucking in interface files
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
\end{code}
-The GhciMode is self-explanatory:
-
-\begin{code}
-data GhciMode = Batch -- ghc --make Main
- | Interactive -- ghc --interactive
- | OneShot -- ghc Foo.hs
- | IDE -- Visual Studio etc
- deriving Eq
-
-isOneShot :: GhciMode -> Bool
-isOneShot OneShot = True
-isOneShot _other = False
-\end{code}
-
\begin{code}
type HomePackageTable = ModuleEnv HomeModInfo -- Domain = modules in the home package
type PackageIfaceTable = ModuleEnv ModIface -- Domain = modules in the imported packages
data HomeModInfo
= HomeModInfo { hm_iface :: ModIface,
- hm_globals :: Maybe GlobalRdrEnv, -- Its top level environment
- -- Nothing <-> compiled module
hm_details :: ModDetails,
hm_linkable :: Linkable }
\end{code}
Nothing -> lookupModuleEnv pit mod
\end{code}
+
+\begin{code}
+hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId]
+-- Find all the instance declarations that are in modules imported
+-- by this one, directly or indirectly, and are in the Home Package Table
+-- This ensures that we don't see instances from modules --make compiled
+-- before this one, but which are not below this one
+hptInstances hsc_env want_this_module
+ = [ dfun
+ | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
+ , want_this_module (mi_module (hm_iface mod_info))
+ , dfun <- md_insts (hm_details mod_info) ]
+
+hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule]
+-- Get rules from modules "below" this one (in the dependency sense)
+-- C.f Inst.hptInstances
+hptRules hsc_env deps
+ | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
+ | otherwise
+ = let
+ hpt = hsc_HPT hsc_env
+ in
+ [ rule
+ | -- Find each non-hi-boot module below me
+ (mod, False) <- deps
+
+ -- Look it up in the HPT
+ , let mod_info = ASSERT( mod `elemModuleEnv` hpt )
+ fromJust (lookupModuleEnv hpt mod)
+
+ -- And get its dfuns
+ , rule <- md_rules (hm_details mod_info) ]
+\end{code}
+
+
%************************************************************************
%* *
\subsection{Symbol tables and Module details}
\begin{code}
data ModIface
= ModIface {
- mi_package :: !IfacePackage, -- Which package the module comes from
+ mi_package :: !PackageIdH, -- Which package the module comes from
mi_module :: !Module,
mi_mod_vers :: !Version, -- Module version: changes when anything changes
-- the version of the parent class/tycon changes
mi_decls :: [(Version,IfaceDecl)], -- Sorted
+ mi_globals :: !(Maybe GlobalRdrEnv),
+ -- Its top level environment or Nothing if we read this
+ -- interface from an interface file. (We need the source
+ -- file to figure out the top-level environment.)
+
-- Instance declarations and rules
mi_insts :: [IfaceInst], -- Sorted
mi_rules :: [IfaceRule], -- Sorted
-- seeing if we are up to date wrt the old interface
}
-data IfacePackage = ThisPackage | ExternalPackage PackageId
-
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
= ModDetails {
data ModGuts
= ModGuts {
mg_module :: !Module,
+ mg_boot :: IsBootInterface, -- Whether it's an hs-boot module
mg_exports :: !NameSet, -- What it exports
mg_deps :: !Dependencies, -- What is below it, directly or otherwise
mg_dir_imps :: ![Module], -- Directly-imported modules; used to
\end{code}
\begin{code}
-emptyModIface :: IfacePackage -> Module -> ModIface
+emptyModIface :: PackageIdH -> Module -> ModIface
emptyModIface pkg mod
= ModIface { mi_package = pkg,
mi_module = mod,
mi_insts = [],
mi_rules = [],
mi_decls = [],
+ mi_globals = Nothing,
mi_rule_vers = initialVersion,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
\end{code}
\begin{code}
-type Gated d = ([Name], (Module, d)) -- The [Name] 'gate' the declaration; always non-empty
- -- Module records which iface file this
- -- decl came from
+type Gated d = ([Name], (Module, SDoc, d))
+ -- The [Name] 'gate' the declaration; always non-empty
+ -- Module records which module this decl belongs to
+ -- SDoc records the pathname of the file, or similar err-ctxt info
type RulePool = [Gated IfaceRule]
%************************************************************************
%* *
+ The ModSummary type
+ A ModSummary is a node in the compilation manager's
+ dependency graph, and it's also passed to hscMain
+%* *
+%************************************************************************
+
+The nodes of the module graph are
+ EITHER a regular Haskell source module
+ OR a hi-boot source module
+
+\begin{code}
+data ModSummary
+ = ModSummary {
+ ms_mod :: Module, -- Name of the module
+ ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core
+ ms_location :: ModLocation, -- Location
+ ms_hs_date :: ClockTime, -- Timestamp of summarised file
+ ms_srcimps :: [Module], -- Source imports
+ ms_imps :: [Module], -- Non-source imports
+ ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source,
+ -- once we have preprocessed it.
+ ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe.
+ }
+
+-- The ModLocation contains both the original source filename and the
+-- filename of the cleaned-up source file after all preprocessing has been
+-- done. The point is that the summariser will have to cpp/unlit/whatever
+-- all files anyway, and there's no point in doing this twice -- just
+-- park the result in a temp file, put the name of it in the location,
+-- and let @compile@ read from that file on the way back up.
+
+-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
+-- the ms_hs_date and imports can, of course, change
+
+msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
+msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
+msHiFilePath ms = ml_hi_file (ms_location ms)
+msObjFilePath ms = ml_obj_file (ms_location ms)
+
+isBootSummary :: ModSummary -> Bool
+isBootSummary ms = isHsBoot (ms_hsc_src ms)
+
+instance Outputable ModSummary where
+ ppr ms
+ = sep [text "ModSummary {",
+ nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
+ text "ms_mod =" <+> ppr (ms_mod ms)
+ <> text (hscSourceString (ms_hsc_src ms)) <> comma,
+ text "ms_imps =" <+> ppr (ms_imps ms),
+ text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
+ char '}'
+ ]
+
+showModMsg :: Bool -> ModSummary -> String
+showModMsg use_object mod_summary
+ = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+ char '(', text (msHsFilePath mod_summary) <> comma,
+ if use_object then text (msObjFilePath mod_summary)
+ else text "interpreted",
+ char ')'])
+ where
+ mod = ms_mod mod_summary
+ mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary)
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection{Linkable stuff}
%* *
%************************************************************************
projects / ghc-hetmet.git / blobdiff