X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=b560566292a1b9acfcc983e018c28f75181c1f81;hb=680f11d3f1ad9065c4969ed5d9db857cc245d778;hp=9da9dc9ae7bc4ae6196d7966547f0ec663de1b02;hpb=138b885a335734039daf7debb0a7dfc3dc947c00;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 9da9dc9..b560566 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,
@@ -11,56 +15,47 @@ 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 )
+import TypeRep
+import Var
+import IdInfo
+import OccName
+import SrcLoc
+import TysWiredIn
+import PrelNames
+import NameEnv
+import TcEnv
 #endif
 
-import HsSyn		( emptyLHsBinds )
-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		( tcIsTyVarTy, tcGetTyVar )
-import NameEnv		( extendNameEnvList, nameEnvElts )
-import InstEnv		( emptyInstEnv )
-import FamInstEnv	( emptyFamInstEnv )
-
-import Var		( setTyVarName )
-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, splitUniqSupply )
-import UniqFM		( unitUFM )
-import Unique		( Unique )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, dopt_set,
-			  dopt_unset, GhcMode ) 
-import StaticFlags	( opt_PprStyle_Debug )
-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}
 
 
@@ -106,8 +101,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,
@@ -115,10 +110,13 @@ 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,
-		tcg_keep     = keep_var
+		tcg_keep     = keep_var,
+		tcg_doc      = Nothing,
+		tcg_hmi      = HaddockModInfo Nothing Nothing Nothing Nothing
 	     } ;
 	     lcl_env = TcLclEnv {
 		tcl_errs       = errs_var,
@@ -150,13 +148,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
@@ -357,8 +348,13 @@ newUniqueSupply
 
 newLocalName :: Name -> TcRnIf gbl lcl Name
 newLocalName name	-- Make a clone
-  = newUnique		`thenM` \ uniq ->
-    returnM (mkInternalName uniq (nameOccName name) (getSrcLoc name))
+  = do	{ uniq <- newUnique
+	; return (mkInternalName uniq (nameOccName name) (getSrcLoc name)) }
+
+newSysLocalIds :: FastString -> [TcType] -> TcRnIf gbl lcl [TcId]
+newSysLocalIds fs tys
+  = do	{ us <- newUniqueSupply
+	; return (zipWith (mkSysLocal fs) (uniqsFromSupply us) tys) }
 \end{code}