cancel out some reverses by changing the order of ic_tmp_ids

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

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 1101e86..d385c5f 100644 (file)
--- 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 )
@@ -85,7 +86,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 )
@@ -93,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 )
@@ -111,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}
 
@@ -129,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.
@@ -614,21 +622,47 @@ 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_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_tmp_ids.  These arise at
+                                        -- breakpoints in a polymorphic 
+                                        -- context, where we have only partial
+                                        -- type information.
 
-       ic_type_env :: TypeEnv          -- Ditto for types
+#ifdef GHCI
+        , ic_resume :: [Resume]         -- the stack of breakpoint contexts
+#endif
     }
 
+
 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],
                         ic_exports = [],
                         ic_rn_gbl_env = emptyGlobalRdrEnv,
-                        ic_rn_local_env = emptyLocalRdrEnv,
-                        ic_type_env = emptyTypeEnv }
+                        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}
 
 %************************************************************************
@@ -1110,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
@@ -1162,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}
 
 %************************************************************************
@@ -1253,6 +1294,8 @@ data ModBreaks
         -- 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
@@ -1260,5 +1303,6 @@ 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}