X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=d385c5f26d4e3aff28af218ed1fae51454b03d8e;hb=88c65644975cb552c8e42d0d998b382d3531cfb3;hp=04f2b7c0e2fcae67f5b134096b279976e08ad3ea;hpb=671b39c5b40e5a3105e4ffb49b673b20ce96ba15;p=ghc-hetmet.git

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 04f2b7c..d385c5f 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -6,7 +6,8 @@
 \begin{code}
 module HscTypes ( 
 	-- * Sessions and compilation state
-	Session(..), HscEnv(..), hscEPS,
+	Session(..), withSession, modifySession, 
+        HscEnv(..), hscEPS,
 	FinderCache, FindResult(..), ModLocationCache,
 	Target(..), TargetId(..), pprTarget, pprTargetId,
 	ModuleGraph, emptyMG,
@@ -14,7 +15,7 @@ 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
@@ -27,7 +28,7 @@ module HscTypes (
 	lookupIfaceByModule, emptyModIface,
 
 	InteractiveContext(..), emptyInteractiveContext, 
-	icPrintUnqual, mkPrintUnqualified,
+	icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
 
 	ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
 	emptyIfaceDepCache,
@@ -59,7 +60,7 @@ module HscTypes (
 	Linkable(..), isObjectLinkable,
 	Unlinked(..), CompiledByteCode,
 	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-        HpcInfo, noHpcInfo,
+        HpcInfo(..), noHpcInfo,
 
         -- Breakpoints
         ModBreaks (..), BreakIndex, emptyModBreaks
@@ -69,10 +70,10 @@ module HscTypes (
 
 #ifdef GHCI
 import ByteCodeAsm	( CompiledByteCode )
+import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
-import RdrName		( GlobalRdrEnv, emptyGlobalRdrEnv,
-			  LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..), 
+import RdrName		( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 
                           unQualOK, ImpDeclSpec(..), Provenance(..),
                           ImportSpec(..), lookupGlobalRdrEnv )
 import Name		( Name, NamedThing, getName, nameOccName, nameModule )
@@ -86,7 +87,7 @@ import FamInstEnv	( FamInstEnv, FamInst )
 import Rules		( RuleBase )
 import CoreSyn		( CoreBind )
 import VarSet
-import Id		( Id, isImplicitId )
+import Id
 import Type		( TyThing(..) )
 
 import Class		( Class, classSelIds, classATs, classTyCon )
@@ -94,7 +95,7 @@ import TyCon
 import DataCon		( DataCon, dataConImplicitIds )
 import PrelNames	( gHC_PRIM )
 import Packages		( PackageId )
-import DynFlags		( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) )
+import DynFlags		( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes	( Version, initialVersion, IPName, 
 			  Fixity, defaultFixity, DeprecTxt )
@@ -112,7 +113,7 @@ import FastString	( FastString )
 import StringBuffer	( StringBuffer )
 
 import System.Time	( ClockTime )
-import Data.IORef	( IORef, readIORef )
+import Data.IORef
 import Data.Array       ( Array, array )
 \end{code}
 
@@ -130,6 +131,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.
@@ -615,30 +622,47 @@ data InteractiveContext
 	ic_rn_gbl_env :: GlobalRdrEnv,	-- The cached GlobalRdrEnv, built from
 					-- ic_toplev_scope and ic_exports
 
-	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_tmp_ids :: [Id],             -- Names bound during interaction.
+                                        -- Later Ids shadow
+                                        -- earlier ones with the same OccName.
 
         ic_tyvars :: TyVarSet           -- skolem type variables free in
-                                        -- ic_type_env.  These arise at
+                                        -- 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_type_env = emptyTypeEnv,
-                         ic_tyvars = emptyVarSet }
+			 ic_tmp_ids = [],
+                         ic_tyvars = emptyVarSet
+#ifdef GHCI
+                         , ic_resume = []
+#endif
+                       }
 
 icPrintUnqual :: InteractiveContext -> PrintUnqualified
 icPrintUnqual ictxt = mkPrintUnqualified (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 }
 \end{code}
 
 %************************************************************************
@@ -1120,6 +1144,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
@@ -1172,10 +1199,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}
 
 %************************************************************************