X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=eb96ca89bc7839a028355e9e997a5f369a777cf7;hp=7467c2ea4fa4619d72fc9dcb5417911aeb4c5aee;hb=241306953f42fa067a9b503ea1f418e75c32c484;hpb=a27d12f02b8ab3a3222c351dcf7e9168dfe05fb0

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 7467c2e..eb96ca8 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -6,6 +6,13 @@
 --
 -- -----------------------------------------------------------------------------
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module InteractiveEval (
 #ifdef GHCI
         RunResult(..), Status(..), Resume(..), History(..),
@@ -14,6 +21,7 @@ module InteractiveEval (
         abandon, abandonAll,
         getResumeContext,
         getHistorySpan,
+        getModBreaks,
         getHistoryModule,
         back, forward,
 	setContext, getContext,	
@@ -151,10 +159,21 @@ getHistorySpan hsc_env hist =
    let inf = historyBreakInfo hist
        num = breakInfo_number inf
    in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
-       Just hmi -> modBreaks_locs (md_modBreaks (hm_details hmi)) ! num
+       Just hmi -> modBreaks_locs (getModBreaks hmi) ! num
        _ -> panic "getHistorySpan"
 
--- | Finds the enclosing top level function name 
+getModBreaks :: HomeModInfo -> ModBreaks
+getModBreaks hmi
+  | Just linkable <- hm_linkable hmi, 
+    [BCOs _ modBreaks] <- linkableUnlinked linkable
+  = modBreaks
+  | otherwise
+  = emptyModBreaks -- probably object code
+
+{- | Finds the enclosing top level function name -}
+-- ToDo: a better way to do this would be to keep hold of the decl_path computed
+-- by the coverage pass, which gives the list of lexically-enclosing bindings
+-- for each tick.
 findEnclosingDecl :: HscEnv -> Module -> SrcSpan -> Id
 findEnclosingDecl hsc_env mod span =
    case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of
@@ -168,13 +187,6 @@ findEnclosingDecl hsc_env mod span =
                                        globals)
            in decl
 
--- | Find the Module corresponding to a FilePath
-findModuleFromFile :: HscEnv -> FilePath -> Maybe Module
-findModuleFromFile hsc_env fp =
-   listToMaybe $ [ms_mod ms | ms <- hsc_mod_graph hsc_env
-                            , ml_hs_file(ms_location ms) == Just (read fp)]
-
-
 -- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: Session -> String -> SingleStep -> IO RunResult
@@ -282,7 +294,7 @@ isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
 isBreakEnabled hsc_env inf =
    case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
        Just hmi -> do
-         w <- getBreak (modBreaks_flags (md_modBreaks (hm_details hmi)))
+         w <- getBreak (modBreaks_flags (getModBreaks hmi))
                        (breakInfo_number inf)
          case w of Just n -> return (n /= 0); _other -> return False
        _ ->
@@ -498,9 +510,10 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
 bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
 
    let 
-       mod_name    = moduleName (breakInfo_module info)
-       mod_details = fmap hm_details (lookupUFM (hsc_HPT hsc_env) mod_name)
-       breaks      = md_modBreaks (expectJust "handlRunStatus" mod_details)
+       mod_name  = moduleName (breakInfo_module info)
+       hmi       = expectJust "bindLocalsAtBreakpoint" $ 
+                        lookupUFM (hsc_HPT hsc_env) mod_name
+       breaks    = getModBreaks hmi
        index     = breakInfo_number info
        vars      = breakInfo_vars info
        result_ty = breakInfo_resty info
@@ -519,8 +532,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
    -- So that we don't fall over in a heap when this happens, just don't
    -- bind any free variables instead, and we emit a warning.
    mb_hValues <- mapM (getIdValFromApStack apStack) offsets
-   let (filtered_hvs, filtered_ids) = 
-                       unzip [ (hv, id) | (id, Just hv) <- zip ids mb_hValues ]
+   let filtered_ids = [ id | (id, Just hv) <- zip ids mb_hValues ]
    when (any isNothing mb_hValues) $
       debugTraceMsg (hsc_dflags hsc_env) 1 $
 	  text "Warning: _result has been evaluated, some bindings have been lost"
@@ -567,13 +579,13 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
 
 rttiEnvironment :: HscEnv -> IO HscEnv 
 rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
-   let InteractiveContext{ic_tmp_ids=tmp_ids, ic_tyvars = tyvars} = ic
+   let InteractiveContext{ic_tmp_ids=tmp_ids} = ic
        incompletelyTypedIds = 
            [id | id <- tmp_ids
                , not $ null [v | v <- varSetElems$ tyVarsOfType (idType id)
                               , isSkolemTyVar v]
                , (occNameFS.nameOccName.idName) id /= result_fs]
-   tys <- reconstructType hsc_env False `mapM` incompletelyTypedIds
+   tys <- reconstructType hsc_env 10 `mapM` incompletelyTypedIds
           -- map termType `fmap` (obtainTerm hsc_env False `mapM` incompletelyTypedIds)
    
    let substs = [computeRTTIsubst ty ty' 
@@ -923,8 +935,8 @@ obtainTerm hsc_env force id =  do
               cvObtainTerm hsc_env maxBound force (Just$ idType id) hv
 
 -- Uses RTTI to reconstruct the type of an Id, making it less polymorphic
-reconstructType :: HscEnv -> Bool -> Id -> IO (Maybe Type)
-reconstructType hsc_env force id = do
+reconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)
+reconstructType hsc_env bound id = do
               hv <- Linker.getHValue hsc_env (varName id) 
-              cvReconstructType hsc_env force (Just$ idType id) hv
+              cvReconstructType hsc_env bound (Just$ idType id) hv
 #endif /* GHCI */