X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=47977703821ecb9a8f50a6ad04e9a8c12d861559;hp=c7926e3c236362a76cad8a31b08d86764e6a2c48;hb=7fa861d23122d4d6a3053c09b5c636bad0478ad3;hpb=cdce647711c0f46f5799b24de087622cb77e647f diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index c7926e3..4797770 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -6,7 +6,8 @@ \begin{code} module HscTypes ( -- * Sessions and compilation state - Session(..), HscEnv(..), hscEPS, + Session(..), withSession, modifySession, + HscEnv(..), hscEPS, FinderCache, FindResult(..), ModLocationCache, Target(..), TargetId(..), pprTarget, pprTargetId, ModuleGraph, emptyMG, @@ -14,7 +15,7 @@ module HscTypes ( ModDetails(..), emptyModDetails, ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..), - ModSummary(..), showModMsg, isBootSummary, + ModSummary(..), ms_mod_name, showModMsg, isBootSummary, msHsFilePath, msHiFilePath, msObjFilePath, HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases @@ -27,7 +28,7 @@ module HscTypes ( lookupIfaceByModule, emptyModIface, InteractiveContext(..), emptyInteractiveContext, - icPrintUnqual, mkPrintUnqualified, + icPrintUnqual, mkPrintUnqualified, extendInteractiveContext, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, emptyIfaceDepCache, @@ -59,20 +60,24 @@ module HscTypes ( Linkable(..), isObjectLinkable, Unlinked(..), CompiledByteCode, isObject, nameOfObject, isInterpretable, byteCodeOfObject, - HpcInfo, noHpcInfo, + HpcInfo(..), noHpcInfo, -- Breakpoints - ModBreaks (..), emptyModBreaks + ModBreaks (..), BreakIndex, emptyModBreaks, + + -- Vectorisation information + VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, + noIfaceVectInfo ) where #include "HsVersions.h" #ifdef GHCI import ByteCodeAsm ( CompiledByteCode ) +import {-# SOURCE #-} InteractiveEval ( Resume ) #endif -import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, - LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..), +import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), unQualOK, ImpDeclSpec(..), Provenance(..), ImportSpec(..), lookupGlobalRdrEnv ) import Name ( Name, NamedThing, getName, nameOccName, nameModule ) @@ -85,7 +90,8 @@ import InstEnv ( InstEnv, Instance ) import FamInstEnv ( FamInstEnv, FamInst ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) -import Id ( Id, isImplicitId ) +import VarSet +import Id import Type ( TyThing(..) ) import Class ( Class, classSelIds, classATs, classTyCon ) @@ -93,7 +99,7 @@ import TyCon import DataCon ( DataCon, dataConImplicitIds ) import PrelNames ( gHC_PRIM ) import Packages ( PackageId ) -import DynFlags ( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) ) +import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) @@ -111,7 +117,7 @@ import FastString ( FastString ) import StringBuffer ( StringBuffer ) import System.Time ( ClockTime ) -import Data.IORef ( IORef, readIORef ) +import Data.IORef import Data.Array ( Array, array ) \end{code} @@ -129,6 +135,12 @@ import Data.Array ( Array, array ) -- constituting the current program or library, the context for -- interactive evaluation, and various caches. newtype Session = Session (IORef HscEnv) + +withSession :: Session -> (HscEnv -> IO a) -> IO a +withSession (Session ref) f = do h <- readIORef ref; f h + +modifySession :: Session -> (HscEnv -> HscEnv) -> IO () +modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h \end{code} HscEnv is like Session, except that some of the fields are immutable. @@ -438,6 +450,9 @@ data ModIface -- instances (for classes and families) -- combined + -- Vectorisation information + mi_vect_info :: !IfaceVectInfo, + -- Cached environments for easy lookup -- These are computed (lazily) from other fields -- and are not put into the interface file @@ -502,7 +517,8 @@ data ModGuts mg_foreign :: !ForeignStubs, mg_deprecs :: !Deprecations, -- Deprecations declared in the module mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes - mg_modBreaks :: !ModBreaks + mg_modBreaks :: !ModBreaks, + mg_vect_info :: !VectInfo -- Pool of vectorised declarations } -- The ModGuts takes on several slightly different forms: @@ -589,6 +605,7 @@ emptyModIface mod mi_decls = [], mi_globals = Nothing, mi_rule_vers = initialVersion, + mi_vect_info = noIfaceVectInfo, mi_dep_fn = emptyIfaceDepCache, mi_fix_fn = emptyIfaceFixCache, mi_ver_fn = emptyIfaceVerCache @@ -614,21 +631,47 @@ data InteractiveContext ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from -- ic_toplev_scope and ic_exports - ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound - -- during interaction + ic_tmp_ids :: [Id], -- Names bound during interaction. + -- Later Ids shadow + -- earlier ones with the same OccName. - ic_type_env :: TypeEnv -- Ditto for types + ic_tyvars :: TyVarSet -- skolem type variables free in + -- ic_tmp_ids. These arise at + -- breakpoints in a polymorphic + -- context, where we have only partial + -- type information. + +#ifdef GHCI + , ic_resume :: [Resume] -- the stack of breakpoint contexts +#endif } + emptyInteractiveContext = InteractiveContext { ic_toplev_scope = [], ic_exports = [], ic_rn_gbl_env = emptyGlobalRdrEnv, - ic_rn_local_env = emptyLocalRdrEnv, - ic_type_env = emptyTypeEnv } + ic_tmp_ids = [], + ic_tyvars = emptyVarSet +#ifdef GHCI + , ic_resume = [] +#endif + } icPrintUnqual :: InteractiveContext -> PrintUnqualified icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt) + + +extendInteractiveContext + :: InteractiveContext + -> [Id] + -> TyVarSet + -> InteractiveContext +extendInteractiveContext ictxt ids tyvars + = ictxt { ic_tmp_ids = ic_tmp_ids ictxt ++ ids, + -- NB. must be this way around, because we want + -- new ids to shadow existing bindings. + ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars } \end{code} %************************************************************************ @@ -989,6 +1032,7 @@ type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv +type PackageVectInfo = VectInfo data ExternalPackageState = EPS { @@ -1025,10 +1069,10 @@ data ExternalPackageState -- modules eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv + eps_vect_info :: !PackageVectInfo, -- Ditto VectInfo eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family - -- instances of each mod - + -- instances of each mod eps_stats :: !EpsStats } @@ -1110,6 +1154,9 @@ data ModSummary ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe. } +ms_mod_name :: ModSummary -> ModuleName +ms_mod_name = moduleName . ms_mod + -- 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 @@ -1162,10 +1209,46 @@ showModMsg target recomp mod_summary %************************************************************************ \begin{code} -type HpcInfo = Int -- just the number of ticks in a module +data HpcInfo = HpcInfo + { hpcInfoTickCount :: Int + , hpcInfoHash :: Int + } + | NoHpcInfo noHpcInfo :: HpcInfo -noHpcInfo = 0 -- default = 0 +noHpcInfo = NoHpcInfo +\end{code} + +%************************************************************************ +%* * +\subsection{Vectorisation Support} +%* * +%************************************************************************ + +The following information is generated and consumed by the vectorisation +subsystem. It communicates the vectorisation status of declarations from one +module to another. + +\begin{code} +-- ModGuts version +data VectInfo = VectInfo { + vectInfoCCVar :: NameSet + } + +-- ModIface version +data IfaceVectInfo = IfaceVectInfo { + ifaceVectInfoCCVar :: [Name] + } + +noVectInfo :: VectInfo +noVectInfo = VectInfo emptyNameSet + +plusVectInfo :: VectInfo -> VectInfo -> VectInfo +plusVectInfo vi1 vi2 = + VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2) + +noIfaceVectInfo :: IfaceVectInfo +noIfaceVectInfo = IfaceVectInfo [] \end{code} %************************************************************************ @@ -1243,18 +1326,25 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) %************************************************************************ \begin{code} --- all the information about the breakpoints for a given module +type BreakIndex = Int + +-- | all the information about the breakpoints for a given module data ModBreaks = ModBreaks - { modBreaks_array :: BreakArray - -- the array of breakpoint flags indexed by tick number - , modBreaks_ticks :: !(Array Int SrcSpan) + { modBreaks_flags :: BreakArray + -- The array of flags, one per breakpoint, + -- indicating which breakpoints are enabled. + , modBreaks_locs :: !(Array BreakIndex SrcSpan) + -- An array giving the source span of each breakpoint. + , modBreaks_vars :: !(Array BreakIndex [OccName]) + -- An array giving the names of the free variables at each breakpoint. } emptyModBreaks :: ModBreaks emptyModBreaks = ModBreaks - { modBreaks_array = error "ModBreaks.modBreaks_array not initialised" + { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised" -- Todo: can we avoid this? - , modBreaks_ticks = array (0,-1) [] + , modBreaks_locs = array (0,-1) [] + , modBreaks_vars = array (0,-1) [] } \end{code}