Comments

[ghc-hetmet.git] / compiler / main / GHC.hs

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index cbe82c4..5c0dbcd 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -142,7 +142,8 @@ module GHC (
        instanceDFunId, pprInstance, pprInstanceHdr,
 
        -- ** Types and Kinds
-       Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
+       Type, dropForAlls, splitForAllTys, funResultTy, 
+       pprParendType, pprTypeApp,
        Kind,
        PredType,
        ThetaType, pprThetaArrow,
@@ -180,6 +181,7 @@ module GHC (
 #include "HsVersions.h"
 
 #ifdef GHCI
+import RtClosureInspect ( cvObtainTerm, Term )
 import TcRnDriver      ( tcRnLookupRdrName, tcRnGetInfo,
                          tcRnLookupName, getModuleExports )
 import RdrName         ( plusGlobalRdrEnv, Provenance(..), 
@@ -188,6 +190,7 @@ import RdrName              ( plusGlobalRdrEnv, Provenance(..),
 import HscMain         ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
 import Name            ( nameOccName )
 import Type            ( tidyType )
+import Var             ( varName )
 import VarEnv          ( emptyTidyEnv )
 import GHC.Exts         ( unsafeCoerce# )
 
@@ -206,7 +209,6 @@ import Data.Maybe       ( fromMaybe)
 import qualified Linker
 
 import Data.Dynamic     ( Dynamic )
-import RtClosureInspect ( cvObtainTerm, Term )
 import Linker          ( HValue, getHValue, extendLinkEnv )
 #endif
 
@@ -218,14 +220,14 @@ import RdrName            ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
 import HsSyn 
 import Type            ( Kind, Type, dropForAlls, PredType, ThetaType,
                          pprThetaArrow, pprParendType, splitForAllTys,
-                         funResultTy )
+                         pprTypeApp, funResultTy )
 import Id              ( Id, idType, isImplicitId, isDeadBinder,
                           isExportedId, isLocalId, isGlobalId,
                           isRecordSelector, recordSelectorFieldLabel,
                           isPrimOpId, isFCallId, isClassOpId_maybe,
                           isDataConWorkId, idDataCon,
                           isBottomingId )
-import Var             ( TyVar, varName )
+import Var             ( TyVar )
 import TysPrim         ( alphaTyVars )
 import TyCon           ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
                          isPrimTyCon, isFunTyCon, isOpenTyCon, tyConArity,
@@ -280,7 +282,6 @@ import System.Exit  ( exitWith, ExitCode(..) )
 import System.Time     ( ClockTime )
 import Control.Exception as Exception hiding (handle)
 import Data.IORef
-import Data.Traversable ( traverse )
 import System.IO
 import System.IO.Error ( isDoesNotExistError )
 import Prelude hiding (init)
@@ -1763,9 +1764,9 @@ data ModuleInfo = ModuleInfo {
        minf_type_env  :: TypeEnv,
        minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
        minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
-       minf_instances :: [Instance],
+       minf_instances :: [Instance]
 #ifdef GHCI
-        minf_dbg_sites :: [(SiteNumber,Coord)] 
+        ,minf_dbg_sites :: [(SiteNumber,Coord)] 
 #endif
        -- ToDo: this should really contain the ModIface too
   }
@@ -2286,7 +2287,10 @@ mkSite (pkgName, modName, sitenum) =
   (mkModule (stringToPackageId pkgName) (mkModuleName modName), sitenum)
 
 obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
-obtainTerm sess force id = withSession sess $ \hsc_env -> 
-              getHValue (varName id) >>= traverse (cvObtainTerm hsc_env force Nothing)
+obtainTerm sess force id = withSession sess $ \hsc_env -> do
+              mb_v <- getHValue (varName id) 
+              case mb_v of
+                Just v  -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
+                Nothing -> return Nothing
 
 #endif /* GHCI */