X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=43063beddb43b7fe6c03a882595b93599e777be0;hp=1101e8627b4388178b2e7654591aa9a4ee95eb9c;hb=deda0c55629600e886f47a5e90bad67953df1ad8;hpb=38e7ac3ffa32d75c1922e7247a910e06d9957116 diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 1101e86..43063be 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -4,9 +4,17 @@ \section[HscTypes]{Types for the per-module compiler} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + 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 +22,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, @@ -59,22 +68,24 @@ module HscTypes ( Linkable(..), isObjectLinkable, Unlinked(..), CompiledByteCode, isObject, nameOfObject, isInterpretable, byteCodeOfObject, - HpcInfo, noHpcInfo, + HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage, -- Breakpoints - ModBreaks (..), BreakIndex, 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(..), - unQualOK, ImpDeclSpec(..), Provenance(..), - ImportSpec(..), lookupGlobalRdrEnv ) +import RdrName import Name ( Name, NamedThing, getName, nameOccName, nameModule ) import NameEnv import NameSet @@ -85,15 +96,18 @@ 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 import DataCon ( DataCon, dataConImplicitIds ) import PrelNames ( gHC_PRIM ) -import Packages ( PackageId ) -import DynFlags ( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) ) +import Packages hiding ( Version(..) ) +import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( Version, initialVersion, IPName, Fixity, defaultFixity, DeprecTxt ) @@ -107,12 +121,13 @@ import SrcLoc ( SrcSpan, Located ) import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) - import StringBuffer ( StringBuffer ) +import Util import System.Time ( ClockTime ) -import Data.IORef ( IORef, readIORef ) +import Data.IORef import Data.Array ( Array, array ) +import Data.List \end{code} @@ -129,6 +144,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. @@ -274,16 +295,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) @@ -315,6 +339,15 @@ hptRules hsc_env deps -- And get its dfuns , 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} %************************************************************************ @@ -438,17 +471,22 @@ 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 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 @@ -457,10 +495,10 @@ data ModDetails -- 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_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_rules :: ![CoreRule], -- Domain may include Ids from other modules + md_vect_info :: !VectInfo -- Vectorisation information } emptyModDetails = ModDetails { md_types = emptyTypeEnv, @@ -468,7 +506,8 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv, md_insts = [], md_rules = [], 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 @@ -487,13 +526,9 @@ data ModGuts mg_usages :: ![Usage], -- Version info for what it needed mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment - mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in - -- this module - - mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment - -- for *home-package* modules (including - -- this one). c.f. tcg_fam_inst_env + -- These fields all describe the things **declared in this module** + mg_fix_env :: !FixityEnv, -- Fixities mg_types :: !TypeEnv, mg_insts :: ![Instance], -- Instances mg_fam_insts :: ![FamInst], -- Instances @@ -502,7 +537,20 @@ 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 next two fields are unusual, because they give instance + -- environments for *all* modules in the home package, including + -- this module, rather than for *just* this module. + -- Reason: when looking up an instance we don't want to have to + -- look at each module in the home package in turn + 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 } -- The ModGuts takes on several slightly different forms: @@ -540,7 +588,8 @@ data CgGuts cg_foreign :: !ForeignStubs, cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen - cg_hpc_info :: !HpcInfo -- info about coverage tick boxes + cg_hpc_info :: !HpcInfo, -- info about coverage tick boxes + cg_modBreaks :: !ModBreaks } ----------------------------------- @@ -564,8 +613,6 @@ data ForeignStubs = NoStubs -- "foreign exported" functions [FastString] -- Headers that need to be included -- into C code generated for this module - [Id] -- Foreign-exported binders - -- we have to generate code to register these \end{code} @@ -589,9 +636,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} @@ -614,21 +663,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 } - -icPrintUnqual :: InteractiveContext -> PrintUnqualified -icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt) + ic_tmp_ids = [], + ic_tyvars = emptyVarSet +#ifdef GHCI + , ic_resume = [] +#endif + } + +icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified +icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (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} %************************************************************************ @@ -637,23 +728,71 @@ icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt) %* * %************************************************************************ +Deciding how to print names is pretty tricky. We are given a name +P:M.T, where P is the package name, M is the defining module, and T is +the occurrence name, and we have to decide in which form to display +the name given a GlobalRdrEnv describing the current scope. + +Ideally we want to display the name in the form in which it is in +scope. However, the name might not be in scope at all, and that's +where it gets tricky. Here are the cases: + + 1. T uniquely maps to P:M.T ---> "T" + 2. there is an X for which X.T uniquely maps to P:M.T ---> "X.T" + 3. there is no binding for "M.T" ---> "M.T" + 4. otherwise ---> "P:M.T" + +3 and 4 apply when P:M.T is not in scope. In these cases we want to +refer to the name as "M.T", but "M.T" might mean something else in the +current scope (e.g. if there's an "import X as M"), so to avoid +confusion we avoid using "M.T" if there's already a binding for it. + +There's one further subtlety: if the module M cannot be imported +because it is not exposed by any package, then we must refer to it as +"P:M". This is handled by the qual_mod component of PrintUnqualified. + \begin{code} -mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified -mkPrintUnqualified env = (qual_name, qual_mod) +mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualified dflags env = (qual_name, qual_mod) where - qual_name mod occ - | null 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" + qual_name mod occ -- The (mod,occ) pair is the original name of the thing + | [gre] <- unqual_gres, right_name gre = NameUnqual + -- 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 = NameQual (get_qual_mod (gre_prov gre)) + + | null qual_gres = + if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env) + then NameNotInScope1 + else NameNotInScope2 + + | 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)) + + -- we can mention a module P:M without the P: qualifier iff + -- "import M" would resolve unambiguously to P:M. (if P is the + -- current package we can just assume it is unqualified). + + qual_mod mod + | modulePackageId mod == thisPackage dflags = False + + | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, + exposed pkg && exposed_module], + packageConfigId pkgconfig == modulePackageId mod + -- this says: we are given a module P:M, is there just one exposed package + -- that exposes a module M, and is it package P? + = False + + | otherwise = True + where lookup = lookupModuleInAllPackages dflags (moduleName mod) \end{code} @@ -769,16 +908,16 @@ lookupType dflags hpt pte name \begin{code} tyThingTyCon (ATyCon tc) = tc -tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other) +tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other) tyThingClass (AClass cls) = cls -tyThingClass other = pprPanic "tyThingClass" (ppr other) +tyThingClass other = pprPanic "tyThingClass" (pprTyThing other) tyThingDataCon (ADataCon dc) = dc -tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other) +tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other) tyThingId (AnId id) = id -tyThingId other = pprPanic "tyThingId" (ppr other) +tyThingId other = pprPanic "tyThingId" (pprTyThing other) \end{code} %************************************************************************ @@ -989,6 +1128,7 @@ type PackageTypeEnv = TypeEnv type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv +type PackageVectInfo = VectInfo data ExternalPackageState = EPS { @@ -1025,10 +1165,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 +1250,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 +1305,86 @@ 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 + { 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 + vectInfoPADFun :: NameEnv (TyCon , Var), -- (T_v, paT) keyed on T_v + 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 emptyNameEnv + +plusVectInfo :: VectInfo -> VectInfo -> VectInfo +plusVectInfo vi1 vi2 = + VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) + (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) + (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) + (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2) + (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) -noHpcInfo :: HpcInfo -noHpcInfo = 0 -- default = 0 +noIfaceVectInfo :: IfaceVectInfo +noIfaceVectInfo = IfaceVectInfo [] [] [] \end{code} %************************************************************************ @@ -1204,7 +1423,7 @@ data Unlinked = DotO FilePath | DotA FilePath | DotDLL FilePath - | BCOs CompiledByteCode + | BCOs CompiledByteCode ModBreaks #ifndef GHCI data CompiledByteCode = NoByteCode @@ -1215,9 +1434,9 @@ instance Outputable Unlinked where ppr (DotA path) = text "DotA" <+> text path ppr (DotDLL path) = text "DotDLL" <+> text path #ifdef GHCI - ppr (BCOs bcos) = text "BCOs" <+> ppr bcos + ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos #else - ppr (BCOs bcos) = text "No byte code" + ppr (BCOs bcos _) = text "No byte code" #endif isObject (DotO _) = True @@ -1232,8 +1451,8 @@ nameOfObject (DotA fn) = fn nameOfObject (DotDLL fn) = fn nameOfObject other = pprPanic "nameOfObject" (ppr other) -byteCodeOfObject (BCOs bc) = bc -byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) +byteCodeOfObject (BCOs bc _) = bc +byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) \end{code} %************************************************************************ @@ -1253,6 +1472,8 @@ data ModBreaks -- 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 @@ -1260,5 +1481,6 @@ 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}