X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=f1b96229a64c10910ba4bbfd47e5f8311496d90e;hb=55a5d8d90280a611bafb659bc80778d3927a6bff;hp=c7926e3c236362a76cad8a31b08d86764e6a2c48;hpb=cdce647711c0f46f5799b24de087622cb77e647f;p=ghc-hetmet.git

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index c7926e3..f1b9622 100644
--- 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}