X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=85cf73e2e1f61bf8d6da074e38a935a69cdccdb2;hp=d3c5f7f74ffa0218067fabd3659cfb8c19ddf621;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=b00b5bc04ff36a551552470060064f0b7d84ca30 diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index d3c5f7f..85cf73e 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,20 +15,21 @@ 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 HomePackageTable, HomeModInfo(..), emptyHomePackageTable, - hptInstances, hptRules, + hptInstances, hptRules, hptVectInfo, ExternalPackageState(..), EpsStats(..), addEpsInStats, PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable, lookupIfaceByModule, emptyModIface, InteractiveContext(..), emptyInteractiveContext, - icPrintUnqual, mkPrintUnqualified, + icPrintUnqual, mkPrintUnqualified, extendInteractiveContext, + substInteractiveContext, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, emptyIfaceDepCache, @@ -51,26 +53,34 @@ module HscTypes ( GenAvailInfo(..), AvailInfo, RdrAvailInfo, IfaceExport, - Deprecations, DeprecTxt, lookupDeprec, plusDeprecs, + Deprecations, DeprecTxt, plusDeprecs, PackageInstEnv, PackageRuleBase, -- Linker stuff Linkable(..), isObjectLinkable, Unlinked(..), CompiledByteCode, - isObject, nameOfObject, isInterpretable, byteCodeOfObject + isObject, nameOfObject, isInterpretable, byteCodeOfObject, + HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage, + + -- Breakpoints + 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(..), - unQualOK, ImpDeclSpec(..), Provenance(..), - ImportSpec(..), lookupGlobalRdrEnv ) +import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), + mkRdrUnqual, ImpDeclSpec(..), Provenance(..), + ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName ) import Name ( Name, NamedThing, getName, nameOccName, nameModule ) import NameEnv import NameSet @@ -81,8 +91,11 @@ import InstEnv ( InstEnv, Instance ) import FamInstEnv ( FamInstEnv, FamInst ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) -import Id ( Id, isImplicitId ) -import Type ( TyThing(..) ) +import VarEnv +import VarSet +import Var hiding ( setIdType ) +import Id +import Type import Class ( Class, classSelIds, classATs, classTyCon ) import TyCon @@ -96,17 +109,19 @@ import BasicTypes ( Version, initialVersion, IPName, import IfaceSyn import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) -import Maybes ( orElse, expectJust ) +import Maybes ( orElse, expectJust, catMaybes, seqMaybe ) import Outputable +import BreakArray import SrcLoc ( SrcSpan, Located ) import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) - -import DATA_IOREF ( IORef, readIORef ) import StringBuffer ( StringBuffer ) -import Maybes ( catMaybes, seqMaybe ) -import Time ( ClockTime ) + +import System.Time ( ClockTime ) +import Data.IORef +import Data.Array ( Array, array ) +import Data.List \end{code} @@ -123,6 +138,12 @@ import Time ( ClockTime ) -- 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. @@ -208,9 +229,15 @@ data TargetId pprTarget :: Target -> SDoc pprTarget (Target id _) = pprTargetId id +instance Outputable Target where + ppr = pprTarget + pprTargetId (TargetModule m) = ppr m pprTargetId (TargetFile f _) = text f +instance Outputable TargetId where + ppr = pprTargetId + type HomePackageTable = ModuleNameEnv HomeModInfo -- Domain = modules in the home package -- "home" package name cached here for convenience @@ -262,16 +289,19 @@ lookupIfaceByModule dflags hpt pit mod \begin{code} -hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance] --- 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 :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst]) +-- Find all the instance declarations (of classes and families) 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 - = [ ispec - | mod_info <- eltsUFM (hsc_HPT hsc_env) - , want_this_module (moduleName (mi_module (hm_iface mod_info))) - , ispec <- md_insts (hm_details mod_info) ] + = let (insts, famInsts) = unzip + [ (md_insts details, md_fam_insts details) + | mod_info <- eltsUFM (hsc_HPT hsc_env) + , want_this_module (moduleName (mi_module (hm_iface mod_info))) + , let details = hm_details mod_info ] + in + (concat insts, concat famInsts) hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule] -- Get rules from modules "below" this one (in the dependency sense) @@ -294,12 +324,24 @@ hptRules hsc_env deps , mod /= moduleName gHC_PRIM -- Look it up in the HPT - , let mod_info = case lookupUFM hpt mod of - Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps) - Just x -> x + , let rules = case lookupUFM hpt mod of + Just info -> md_rules (hm_details info) + Nothing -> pprTrace "WARNING in hptRules" msg [] + msg = vcat [ptext SLIT("missing module") <+> ppr mod, + ptext SLIT("Probable cause: out-of-date interface files")] + -- This really shouldn't happen, but see Trac #962 -- And get its dfuns - , rule <- md_rules (hm_details mod_info) ] + , rule <- rules ] + +hptVectInfo :: HscEnv -> VectInfo +-- Get the combined VectInfo of all modules in the home package table. In +-- contrast to instances and rules, we don't care whether the modules are +-- "below" or us. The VectInfo of those modules not "below" us does not +-- affect the compilation of the current module. +hptVectInfo hsc_env + = foldr plusVectInfo noVectInfo [ md_vect_info (hm_details mod_info) + | mod_info <- eltsUFM (hsc_HPT hsc_env)] \end{code} %************************************************************************ @@ -366,6 +408,7 @@ data ModIface mi_mod_vers :: !Version, -- Module version: changes when anything changes mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans + mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts mi_boot :: !IsBootInterface, -- Read from an hi-boot file? mi_deps :: Dependencies, @@ -419,37 +462,48 @@ data ModIface mi_fam_insts :: [IfaceFamInst], -- Sorted mi_rules :: [IfaceRule], -- Sorted mi_rule_vers :: !Version, -- Version number for rules and - -- instances combined + -- 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 mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities - mi_ver_fn :: OccName -> Maybe (OccName, Version) + mi_ver_fn :: OccName -> Maybe (OccName, Version), -- Cached lookup for mi_decls -- The Nothing in mi_ver_fn means that the thing -- isn't in decls. It's useful to know that when -- seeing if we are up to date wrt the old interface -- The 'OccName' is the parent of the name, if it has one. + mi_hpc :: !AnyHpcUsage + -- True if this program uses Hpc at any point in the program. } -- Should be able to construct ModDetails from mi_decls in ModIface data ModDetails = ModDetails { - -- The next three fields are created by the typechecker - md_exports :: [AvailInfo], - md_types :: !TypeEnv, - md_fam_insts :: ![FamInst], -- Cached value extracted from md_types - md_insts :: ![Instance], -- Dfun-ids for the instances in this module - md_rules :: ![CoreRule] -- Domain may include Ids from other modules + -- The next two fields are created by the typechecker + md_exports :: [AvailInfo], + md_types :: !TypeEnv, + md_insts :: ![Instance], -- Dfun-ids for the instances in this module + md_fam_insts :: ![FamInst], + md_rules :: ![CoreRule], -- Domain may include Ids from other modules + md_modBreaks :: !ModBreaks, -- Breakpoint information for this module + md_vect_info :: !VectInfo -- Vectorisation information } emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_exports = [], md_insts = [], md_rules = [], - md_fam_insts = [] } + md_fam_insts = [], + md_modBreaks = emptyModBreaks, + md_vect_info = noVectInfo + } -- A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -470,14 +524,24 @@ data ModGuts mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in -- this module - mg_deprecs :: !Deprecations, -- Deprecations declared in the module + + mg_inst_env :: InstEnv, -- Class instance enviroment fro + -- *home-package* modules (including + -- this one); c.f. tcg_inst_env + mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment + -- for *home-package* modules (including + -- this one); c.f. tcg_fam_inst_env mg_types :: !TypeEnv, mg_insts :: ![Instance], -- Instances mg_fam_insts :: ![FamInst], -- Instances mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module - mg_foreign :: !ForeignStubs + mg_foreign :: !ForeignStubs, + mg_deprecs :: !Deprecations, -- Deprecations declared in the module + mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes + mg_modBreaks :: !ModBreaks, + mg_vect_info :: !VectInfo -- Pool of vectorised declarations } -- The ModGuts takes on several slightly different forms: @@ -514,7 +578,8 @@ data CgGuts -- initialisation code cg_foreign :: !ForeignStubs, - cg_dep_pkgs :: ![PackageId] -- Used to generate #includes for C code gen + cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen + cg_hpc_info :: !HpcInfo -- info about coverage tick boxes } ----------------------------------- @@ -549,6 +614,7 @@ emptyModIface mod = ModIface { mi_module = mod, mi_mod_vers = initialVersion, mi_orphan = False, + mi_finsts = False, mi_boot = False, mi_deps = noDependencies, mi_usages = [], @@ -562,9 +628,11 @@ 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 + mi_ver_fn = emptyIfaceVerCache, + mi_hpc = False } \end{code} @@ -587,21 +655,63 @@ 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 } + + +substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext +substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt +substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst = + let ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids + subst_dom= varEnvKeys$ getTvSubstEnv subst + subst_ran= varEnvElts$ getTvSubstEnv subst + new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran] + ic_tyvars'= (`delVarSetListByKey` subst_dom) + . (`extendVarSetList` new_tvs) + $ ic_tyvars ictxt + in ictxt { ic_tmp_ids = ids' + , ic_tyvars = ic_tyvars' } + + where delVarSetListByKey = foldl' delVarSetByKey \end{code} %************************************************************************ @@ -614,19 +724,28 @@ icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt) mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified env = (qual_name, qual_mod) where - qual_name mod occ - | null gres = Just (moduleName mod) + qual_name mod occ -- The (mod,occ) pair is the original name of the thing + | [gre] <- unqual_gres, right_name gre = Nothing + -- If there's a unique entity that's in scope unqualified with 'occ' + -- AND that entity is the right one, then we can use the unqualified name + + | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre)) + + | null qual_gres = Just (moduleName mod) -- it isn't in scope at all, this probably shouldn't happen, -- but we'll qualify it by the original module anyway. - | any unQualOK gres = Nothing - | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is - = Just (is_as (is_decl idecl)) - | otherwise = panic "mkPrintUnqualified" + + | otherwise = panic "mkPrintUnqualified" where - gres = [ gre | gre <- lookupGlobalRdrEnv env occ, - nameModule (gre_name gre) == mod ] + right_name gre = nameModule (gre_name gre) == mod + + unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env + qual_gres = filter right_name (lookupGlobalRdrEnv env occ) - qual_mod mod = Nothing -- For now... + get_qual_mod LocalDef = moduleName mod + get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is)) + + qual_mod mod = Nothing -- For now, we never qualify module names with their packages \end{code} @@ -651,12 +770,14 @@ implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++ concatMap (extras_plus . ADataCon) (tyConDataCons tc) - -- For classes, add the class TyCon too (and its extras) - -- and the class selector Ids and the associated types (they don't - -- have extras as these are only the family decls) -implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++ - map ATyCon (classATs cl) ++ - extras_plus (ATyCon (classTyCon cl)) + -- For classes, add the class selector Ids, and assoicated TyCons + -- and the class TyCon too (and its extras) +implicitTyThings (AClass cl) + = map AnId (classSelIds cl) ++ + map ATyCon (classATs cl) ++ + -- No extras_plus for the classATs, because they + -- are only the family decls; they have no implicit things + extras_plus (ATyCon (classTyCon cl)) -- For data cons add the worker and wrapper (if any) implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc) @@ -800,13 +921,6 @@ mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName emptyIfaceDepCache :: Name -> Maybe DeprecTxt emptyIfaceDepCache n = Nothing -lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt -lookupDeprec NoDeprecs name = Nothing -lookupDeprec (DeprecAll txt) name = Just txt -lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of - Just (_, txt) -> Just txt - Nothing -> Nothing - plusDeprecs :: Deprecations -> Deprecations -> Deprecations plusDeprecs d NoDeprecs = d plusDeprecs NoDeprecs d = d @@ -853,11 +967,8 @@ instance Outputable n => Outputable (GenAvailInfo n) where ppr = pprAvail pprAvail :: Outputable n => GenAvailInfo n -> SDoc -pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of - [] -> empty - ns' -> braces (hsep (punctuate comma (map ppr ns'))) - -pprAvail (Avail n) = ppr n +pprAvail (Avail n) = ppr n +pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns))) \end{code} \begin{code} @@ -903,22 +1014,32 @@ type WhetherHasOrphans = Bool -- * a transformation rule in a module other than the one defining -- the function in the head of the rule. +type WhetherHasFamInst = Bool -- This module defines family instances? + type IsBootInterface = Bool -- Dependency info about modules and packages below this one -- in the import hierarchy. See TcRnTypes.ImportAvails for details. +-- The orphan modules in `dep_orphs' do *not* include family instance orphans, +-- as they are anyway included in `dep_finsts'. -- -- Invariant: the dependencies of a module M never includes M -- Invariant: the lists are unordered, with no duplicates data Dependencies - = Deps { dep_mods :: [(ModuleName,IsBootInterface)], -- Home-package module dependencies - dep_pkgs :: [PackageId], -- External package dependencies - dep_orphs :: [Module] } -- Orphan modules (whether home or external pkg) + = Deps { dep_mods :: [(ModuleName, -- Home-package module dependencies + IsBootInterface)] + , dep_pkgs :: [PackageId] -- External package dependencies + , dep_orphs :: [Module] -- Orphan modules (whether home or + -- external pkg) + , dep_finsts :: [Module] -- Modules that contain family + -- instances (whether home or + -- external pkg) + } deriving( Eq ) -- Equality used only for old/new comparison in MkIface.addVersionInfo noDependencies :: Dependencies -noDependencies = Deps [] [] [] +noDependencies = Deps [] [] [] [] data Usage = Usage { usg_name :: ModuleName, -- Name of the module @@ -960,6 +1081,7 @@ type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv +type PackageVectInfo = VectInfo data ExternalPackageState = EPS { @@ -996,7 +1118,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 eps_stats :: !EpsStats } @@ -1078,6 +1203,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 @@ -1112,7 +1240,7 @@ showModMsg target recomp mod_summary = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), char '(', text (msHsFilePath mod_summary) <> comma, case target of - HscInterpreted | recomp + HscInterpreted | recomp -> text "interpreted" HscNothing -> text "nothing" _other -> text (msObjFilePath mod_summary), @@ -1125,6 +1253,93 @@ showModMsg target recomp mod_summary %************************************************************************ %* * +\subsection{Hpc Support} +%* * +%************************************************************************ + +\begin{code} +data HpcInfo + = HpcInfo + { hpcInfoTickCount :: Int + , hpcInfoHash :: Int + } + | NoHpcInfo + { hpcUsed :: AnyHpcUsage -- is hpc used anywhere on the module tree? + } + +-- This is used to mean there is no module-local hpc usage, +-- but one of my imports used hpc instrumentation. + +type AnyHpcUsage = Bool + +emptyHpcInfo :: AnyHpcUsage -> HpcInfo +emptyHpcInfo = NoHpcInfo + +isHpcUsed :: HpcInfo -> AnyHpcUsage +isHpcUsed (HpcInfo {}) = True +isHpcUsed (NoHpcInfo { hpcUsed = used }) = used +\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. + +Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo +below? We need to know `f' when converting to IfaceVectInfo. However, during +vectorisation, we need to know `f_v', whose `Var' we cannot lookup based +on just the OccName easily in a Core pass. + +\begin{code} +-- ModGuts/ModDetails/EPS version +data VectInfo + = VectInfo { + vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f + vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T + vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C + vectInfoIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T + } + -- all of this is always tidy, even in ModGuts + +-- ModIface version +data IfaceVectInfo + = IfaceVectInfo { + ifaceVectInfoVar :: [Name], + -- all variables in here have a vectorised variant; + -- the name of the vectorised variant is determined by `mkCloVect' + ifaceVectInfoTyCon :: [Name], + -- all tycons in here have a vectorised variant; + -- the name of the vectorised variant and those of its + -- data constructors are determined by `mkVectTyConOcc' + -- and `mkVectDataConOcc'; the names of + -- the isomorphisms is determined by `mkVectIsoOcc' + ifaceVectInfoTyConReuse :: [Name] + -- the vectorised form of all the tycons in here coincids with + -- the unconverted from; the names of the isomorphisms is determined + -- by `mkVectIsoOcc' + } + +noVectInfo :: VectInfo +noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv + +plusVectInfo :: VectInfo -> VectInfo -> VectInfo +plusVectInfo vi1 vi2 = + VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) + (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) + (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) + (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) + +noIfaceVectInfo :: IfaceVectInfo +noIfaceVectInfo = IfaceVectInfo [] [] [] +\end{code} + +%************************************************************************ +%* * \subsection{Linkable stuff} %* * %************************************************************************ @@ -1191,5 +1406,32 @@ byteCodeOfObject (BCOs bc) = bc byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) \end{code} +%************************************************************************ +%* * +\subsection{Breakpoint Support} +%* * +%************************************************************************ +\begin{code} +type BreakIndex = Int + +-- | all the information about the breakpoints for a given module +data ModBreaks + = ModBreaks + { 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_flags = error "ModBreaks.modBreaks_array not initialised" + -- Todo: can we avoid this? + , modBreaks_locs = array (0,-1) [] + , modBreaks_vars = array (0,-1) [] + } +\end{code}