lookupIfaceByModule, emptyModIface,
InteractiveContext(..), emptyInteractiveContext,
- icPrintUnqual, mkPrintUnqualified,
+ icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
emptyIfaceDepCache,
Linkable(..), isObjectLinkable,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
- HpcInfo, noHpcInfo
+ HpcInfo, noHpcInfo,
+
+ -- Breakpoints
+ ModBreaks (..), BreakIndex, emptyModBreaks
) where
#include "HsVersions.h"
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 )
import DataCon ( DataCon, dataConImplicitIds )
import PrelNames ( gHC_PRIM )
import Packages ( PackageId )
-import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
+import DynFlags ( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
import CoreSyn ( CoreRule )
import Maybes ( orElse, expectJust, catMaybes, seqMaybe )
import Outputable
+import BreakArray
import SrcLoc ( SrcSpan, Located )
import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import System.Time ( ClockTime )
import Data.IORef ( IORef, readIORef )
+import Data.Array ( Array, array )
\end{code}
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_rules :: ![CoreRule], -- Domain may include Ids from other modules
+ md_modBreaks :: !ModBreaks -- breakpoint information for this module
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = [],
md_insts = [],
md_rules = [],
- md_fam_insts = [] }
+ md_fam_insts = [],
+ md_modBreaks = emptyModBreaks }
-- 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
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_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_rules :: ![CoreRule], -- Rules from this module
mg_binds :: ![CoreBind], -- Bindings for this module
mg_foreign :: !ForeignStubs,
- mg_hpc_info :: !HpcInfo -- info about coverage tick boxes
+ mg_deprecs :: !Deprecations, -- Deprecations declared in the module
+ mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
+ mg_modBreaks :: !ModBreaks
}
-- The ModGuts takes on several slightly different forms:
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_type_env :: TypeEnv -- Ditto for types
+ ic_type_env :: TypeEnv, -- Type env for names bound during
+ -- interaction. NB. the names from
+ -- these Ids are used to populate
+ -- the LocalRdrEnv used during
+ -- typechecking of a statement, so
+ -- there should be no duplicate
+ -- names in here.
+
+ ic_tyvars :: TyVarSet -- skolem type variables free in
+ -- ic_type_env. These arise at
+ -- breakpoints in a polymorphic
+ -- context, where we have only partial
+ -- type information.
}
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
- ic_rn_local_env = emptyLocalRdrEnv,
- ic_type_env = emptyTypeEnv }
+ ic_type_env = emptyTypeEnv,
+ ic_tyvars = emptyVarSet }
icPrintUnqual :: InteractiveContext -> PrintUnqualified
icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+
+
+extendInteractiveContext
+ :: InteractiveContext
+ -> [Id]
+ -> TyVarSet
+ -> InteractiveContext
+extendInteractiveContext ictxt ids tyvars
+ = ictxt { ic_type_env = extendTypeEnvWithIds filtered_type_env ids,
+ ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars }
+ where
+ type_env = ic_type_env ictxt
+ bound_names = map idName ids
+ -- Remove any shadowed bindings from the type_env;
+ -- we aren't allowed any duplicates because the LocalRdrEnv is
+ -- build directly from the Ids in the type env in here.
+ old_bound_names = map idName (typeEnvIds type_env)
+ shadowed = [ n | name <- bound_names,
+ n <- old_bound_names,
+ nameOccName name == nameOccName n ]
+ filtered_type_env = delListFromNameEnv type_env shadowed
\end{code}
%************************************************************************
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)
= 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),
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}
projects / ghc-hetmet.git / blobdiff