X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=6a7f4fb3d5cfc93af91cbfe873c728c03d95ae14;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=d9fe12aa2f55538e59eddfa91d48a887fac473d9;hpb=190f24892156953d73b55401d0467a6f1a88ce5d;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index d9fe12a..6a7f4fb 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -1,3 +1,7 @@
+%
+% (c) The University of Glasgow 2006
+%
+
 \begin{code}
 module TcRnMonad(
 	module TcRnMonad,
@@ -10,59 +14,44 @@ module TcRnMonad(
 import TcRnTypes	-- Re-export all
 import IOEnv		-- Re-export all
 
-#if defined(GHCI) && defined(BREAKPOINT)
-import TypeRep          ( Type(..), liftedTypeKind )
-import Var              ( mkTyVar, mkGlobalId )
-import IdInfo           ( GlobalIdDetails(..), vanillaIdInfo )
-import OccName          ( mkOccName, tvName )
-import SrcLoc           ( noSrcLoc  )
-import TysWiredIn       ( intTy, stringTy, mkListTy, unitTy, boolTy )
-import PrelNames        ( breakpointJumpName, breakpointCondJumpName )
-import NameEnv          ( mkNameEnv )
-import TcEnv            ( tcExtendIdEnv )
+#if defined(GHCI)
+import TypeRep
+import IdInfo
+import TysWiredIn
+import PrelNames
+import {-#SOURCE#-} TcEnv
 #endif
 
-import HsSyn		( emptyLHsBinds, HaddockModInfo(..) )
-import HscTypes		( HscEnv(..), ModGuts(..), ModIface(..),
-			  TypeEnv, emptyTypeEnv, HscSource(..), isHsBoot,
-			  ExternalPackageState(..), HomePackageTable,
-			  Deprecs(..), FixityEnv, FixItem, 
-			  mkPrintUnqualified )
-import Module		( Module, moduleName )
-import RdrName		( GlobalRdrEnv, LocalRdrEnv, emptyLocalRdrEnv )
-import Name		( Name, mkInternalName, tidyNameOcc, nameOccName, getSrcLoc )
-import Type		( Type )
-import TcType		( TcType, tcIsTyVarTy, tcGetTyVar )
-import NameEnv		( extendNameEnvList, nameEnvElts )
-import InstEnv		( emptyInstEnv )
-import FamInstEnv	( emptyFamInstEnv )
-
-import Var		( setTyVarName )
-import Id		( mkSysLocal )
-import VarSet		( emptyVarSet )
-import VarEnv		( TidyEnv, emptyTidyEnv, extendVarEnv )
-import ErrUtils		( Message, Messages, emptyMessages, errorsFound, 
-			  mkWarnMsg, printErrorsAndWarnings,
-			  mkLocMessage, mkLongErrMsg )
-import SrcLoc		( mkGeneralSrcSpan, isGoodSrcSpan, SrcSpan, Located(..) )
-import NameEnv		( emptyNameEnv )
-import NameSet		( NameSet, emptyDUs, emptyNameSet, unionNameSets, addOneToNameSet )
-import OccName		( emptyOccEnv, tidyOccName )
-import Bag		( emptyBag )
+import HsSyn hiding (LIE)
+import HscTypes
+import Module
+import RdrName
+import Name
+import TcType
+import InstEnv
+import FamInstEnv
+
+import Var
+import Id
+import VarSet
+import VarEnv
+import ErrUtils
+import SrcLoc
+import NameEnv
+import NameSet
+import OccName
+import Bag
 import Outputable
-import UniqSupply	( UniqSupply, mkSplitUniqSupply, uniqFromSupply, uniqsFromSupply, splitUniqSupply )
-import UniqFM		( unitUFM )
-import Unique		( Unique )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, dopt_set,
-			  dopt_unset, GhcMode ) 
-import StaticFlags	( opt_PprStyle_Debug )
-import FastString	( FastString )
-import Bag		( snocBag, unionBags )
-import Panic		( showException )
+import UniqSupply
+import Unique
+import DynFlags
+import StaticFlags
+import FastString
+import Panic
  
-import IO		( stderr )
-import DATA_IOREF	( newIORef, readIORef )
-import EXCEPTION	( Exception )
+import System.IO
+import Data.IORef
+import Control.Exception
 \end{code}
 
 
@@ -79,6 +68,7 @@ ioToTcRn = ioToIOEnv
 \end{code}
 
 \begin{code}
+
 initTc :: HscEnv
        -> HscSource
        -> Module 
@@ -108,8 +98,8 @@ initTc hsc_env hsc_src mod do_this
 		tcg_fam_inst_env  = emptyFamInstEnv,
 		tcg_inst_uses = dfuns_var,
 		tcg_th_used   = th_var,
-		tcg_exports  = emptyNameSet,
-		tcg_imports  = init_imports,
+		tcg_exports  = [],
+		tcg_imports  = emptyImportAvails,
 		tcg_dus      = emptyDUs,
                 tcg_rn_imports = Nothing,
                 tcg_rn_exports = Nothing,
@@ -117,6 +107,7 @@ initTc hsc_env hsc_src mod do_this
 		tcg_binds    = emptyLHsBinds,
 		tcg_deprecs  = NoDeprecs,
 		tcg_insts    = [],
+		tcg_fam_insts= [],
 		tcg_rules    = [],
 		tcg_fords    = [],
 		tcg_dfun_n   = dfun_n_var,
@@ -154,13 +145,6 @@ initTc hsc_env hsc_src mod do_this
 
 	return (msgs, final_res)
     }
-  where
-    init_imports = emptyImportAvails {imp_env = 
-					unitUFM (moduleName mod) emptyNameSet}
-	-- Initialise tcg_imports with an empty set of bindings for
-	-- this module, so that if we see 'module M' in the export
-	-- list, and there are no bindings in M, we don't bleat 
-	-- "unknown module M".
 
 initTcPrintErrors	-- Used from the interactive loop only
        :: HscEnv
@@ -176,7 +160,7 @@ initTcPrintErrors env mod todo = do
 \begin{code}
 addBreakpointBindings :: TcM a -> TcM a
 addBreakpointBindings thing_inside
-#if defined(GHCI) && defined(BREAKPOINT)
+#if defined(GHCI)
   = do	{ unique <- newUnique
         ; let { var = mkInternalName unique (mkOccName tvName "a") noSrcLoc;
                 tyvar = mkTyVar var liftedTypeKind;
@@ -188,10 +172,10 @@ addBreakpointBindings thing_inside
                                        (FunTy (TyVarTy tyvar)
                                         (TyVarTy tyvar)))))));
                 breakpointJumpId
-                    = mkGlobalId VanillaGlobal breakpointJumpName
+                    = Id.mkGlobalId VanillaGlobal breakpointJumpName
                                  (basicType id) vanillaIdInfo;
                 breakpointCondJumpId
-                    = mkGlobalId VanillaGlobal breakpointCondJumpName
+                    = Id.mkGlobalId VanillaGlobal breakpointCondJumpName
                                  (basicType (FunTy boolTy)) vanillaIdInfo
 	  }
 	; tcExtendIdEnv [breakpointJumpId, breakpointCondJumpId] thing_inside}