X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fghci%2FRtClosureInspect.hs;h=790749b1fac7688a923b11120dd99034b3548160;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=9161ae43f463afcd7412cb4e7e5336dbf02745cf;hpb=2c92736ea5a4aedf263a77d58c6e9b032a05b7ef;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 9161ae4..790749b 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -13,7 +13,6 @@ module RtClosureInspect(
      AddressEnv(..), 
      DataConEnv,
      extendAddressEnvList, 
-     extendAddressEnvList', 
      elemAddressEnv, 
      delFromAddressEnv, 
      emptyAddressEnv, 
@@ -51,22 +50,18 @@ import HscTypes         ( HscEnv )
 
 import DataCon          
 import Type             
-import TcRnMonad
+import TcRnMonad        ( TcM, initTcPrintErrors, ioToTcRn, recoverM, writeMutVar )
 import TcType
 import TcMType
 import TcUnify
 import TcGadt
-import DriverPhases
 import TyCon		
 import Var
 import Name 
+import VarEnv
+import OccName
+import VarSet
 import Unique
-import UniqSupply
-import Var              ( setVarUnique, mkTyVar, tyVarKind, setTyVarKind )
-import VarEnv           ( mkVarEnv )
-import OccName          ( emptyTidyOccEnv )
-import VarSet           ( VarSet, mkVarSet, varSetElems, unionVarSets )
-import Unique           ( getUnique, incrUnique )
 import {-#SOURCE#-} TcRnDriver ( tcRnRecoverDataCon )
 
 import TysPrim		
@@ -74,9 +69,10 @@ import PrelNames
 import TysWiredIn
 
 import Constants        ( wORD_SIZE )
-import FastString       ( mkFastString )
 import Outputable
+import Maybes
 import Panic
+import FiniteMap
 
 import GHC.Arr          ( Array(..) )
 import GHC.Ptr          ( Ptr(..), castPtr )
@@ -84,15 +80,11 @@ import GHC.Exts
 import GHC.Int          ( Int32(..),  Int64(..) )
 import GHC.Word         ( Word32(..), Word64(..) )
 
-import Control.Monad    ( liftM, liftM2, msum )
+import Control.Monad
 import Data.Maybe
-import Data.List
-import Data.Traversable ( mapM )
 import Data.Array.Base
+import Data.List        ( partition )
 import Foreign.Storable
-import Foreign          ( unsafePerformIO )
-
-import Prelude hiding ( mapM )
 
 ---------------------------------------------
 -- * A representation of semi evaluated Terms
@@ -546,7 +538,7 @@ zonkTerm = foldTerm idTermFoldM {
               fTerm = \ty dc v tt -> sequence tt      >>= \tt ->
                                      zonkTcType ty    >>= \ty' ->
                                      return (Term ty' dc v tt)
-             ,fSuspension = \ct ty v b -> mapM zonkTcType ty >>= \ty ->
+             ,fSuspension = \ct ty v b -> fmapMMaybe zonkTcType ty >>= \ty ->
                                           return (Suspension ct ty v b)}  
 
 {-
@@ -608,28 +600,25 @@ NOTE: (Num t) contexts have been manually replaced by Integer for clarity
 type DataConEnv   = AddressEnv StgInfoTable
 
 -- Note that this AddressEnv and DataConEnv I wrote trying to follow 
--- conventions in ghc, but probably they make no sense. Should 
--- probably be replaced by a plain Data.Map
+-- conventions in ghc, but probably they make not much sense.
 
-newtype AddressEnv a = AE {outAE::[(Ptr a, Name)]}
+newtype AddressEnv a = AE {aenv:: FiniteMap (Ptr a) Name}
+  deriving (Outputable)
 
-emptyAddressEnv = AE []
+emptyAddressEnv = AE emptyFM
 
 extendAddressEnvList  :: AddressEnv a -> [(Ptr a, Name)] -> AddressEnv a
-extendAddressEnvList' :: AddressEnv a -> [(Ptr a, Name)] -> AddressEnv a
 elemAddressEnv        :: Ptr a -> AddressEnv a -> Bool
 delFromAddressEnv     :: AddressEnv a -> Ptr a -> AddressEnv a
 nullAddressEnv        :: AddressEnv a -> Bool
 lookupAddressEnv       :: AddressEnv a -> Ptr a -> Maybe Name
 
-extendAddressEnvList  (AE env) = AE . nub . (++ env) 
-extendAddressEnvList' (AE env) = AE . (++ env)
-elemAddressEnv ptr    (AE env) = ptr `elem` fst (unzip env) 
-delFromAddressEnv (AE env) ptr = AE [(ptr', n) | (ptr', n) <- env, ptr' /= ptr]
-nullAddressEnv                 = null . outAE
-lookupAddressEnv       (AE env) = flip lookup env
-
-instance Outputable (AddressEnv a) where
- ppr (AE ae) = vcat [text (show ptr) <> comma <> ppr a | (ptr,a) <- ae] 
+extendAddressEnvList  (AE env) = AE . addListToFM env 
+elemAddressEnv   ptr  (AE env) = ptr `elemFM` env
+delFromAddressEnv     (AE env) = AE . delFromFM env
+nullAddressEnv                 = isEmptyFM . aenv
+lookupAddressEnv      (AE env) = lookupFM env
 
 
+instance Outputable (Ptr a) where
+  ppr = text . show
\ No newline at end of file