Big tidy-up of deriving code

[ghc-hetmet.git] / compiler / ghci / RtClosureInspect.hs

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