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 Breakpoints ( SiteNumber, Coord, noDbgSites )
#ifdef GHCI
import ByteCodeAsm ( CompiledByteCode )
#endif
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 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_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_dbg_sites :: ![(SiteNumber, Coord)] -- Breakpoint sites inserted by the renamer
+ md_modBreaks :: !ModBreaks -- breakpoint information for this module
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_insts = [],
md_rules = [],
md_fam_insts = [],
- md_dbg_sites = noDbgSites}
+ 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_foreign :: !ForeignStubs,
mg_deprecs :: !Deprecations, -- Deprecations declared in the module
mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
- mg_dbg_sites :: ![(SiteNumber, Coord)] -- Bkpts inserted by the renamer
+ 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}
%************************************************************************
= showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
char '(', text (msHsFilePath mod_summary) <> comma,
case target of
-#if defined(GHCI) && defined(DEBUGGER)
- HscInterpreted | recomp &&
- Opt_Debugging `elem` modflags
- -> text "interpreted(debugging)"
-#endif
HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
- modflags= flags(ms_hspp_opts mod_summary)
\end{code}
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}