Changing internal data structures used by Hpc

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index c7926e3..f1b9622 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -27,7 +27,7 @@ module HscTypes (
        lookupIfaceByModule, emptyModIface,
 
        InteractiveContext(..), emptyInteractiveContext, 
-       icPrintUnqual, mkPrintUnqualified,
+       icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
        emptyIfaceDepCache,
@@ -59,10 +59,10 @@ module HscTypes (
        Linkable(..), isObjectLinkable,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-        HpcInfo, noHpcInfo,
+        HpcInfo(..), noHpcInfo,
 
         -- Breakpoints
-        ModBreaks (..), emptyModBreaks
+        ModBreaks (..), BreakIndex, emptyModBreaks
     ) where
 
 #include "HsVersions.h"
@@ -85,7 +85,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 )
@@ -614,21 +615,51 @@ 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_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}
 
 %************************************************************************
@@ -1162,10 +1193,14 @@ 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}
 
 %************************************************************************
@@ -1243,18 +1278,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}