X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcEnv.lhs;h=edfd1f232e9d287157b919be418ce45f82b6107c;hb=ecd5cb36ad575939b04f40d1b3a7255741f294a2;hp=0444dd9680a0ed15afaae8c69cce183f374e2760;hpb=435b542fea3ccda11376b0422a5ee564ddeba5c7;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 0444dd9..edfd1f2 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -1,18 +1,19 @@
 \begin{code}
 module TcEnv(
 	TcId, TcIdSet, 
-	TyThing(..), TyThingDetails(..),
+	TyThing(..), TyThingDetails(..), TcTyThing(..),
 
 	-- Getting stuff from the environment
 	TcEnv, initTcEnv, 
-	tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds,
+	tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
 	
 	-- Instance environment
 	tcGetInstEnv, tcSetInstEnv, 
 
 	-- Global environment
 	tcExtendGlobalEnv, tcExtendGlobalValEnv, 
-	tcLookupTy, tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
+	tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
+	tcLookupGlobal_maybe,
 
 	-- Local environment
 	tcExtendKindEnv, 
@@ -55,14 +56,15 @@ import Class	( Class, ClassOpItem, ClassContext, classTyCon )
 import Subst	( substTy )
 import Name	( Name, OccName, Provenance(..), ExportFlag(..), NamedThing(..), 
 		  nameOccName, nameModule, getSrcLoc, mkGlobalName,
-		  maybeWiredInTyConName, maybeWiredInIdName, isLocallyDefined,
+		  isLocallyDefined,
 		  NameEnv, emptyNameEnv, lookupNameEnv, nameEnvElts, 
 		  extendNameEnv, extendNameEnvList
 		)
 import OccName	( mkDFunOcc, mkDefaultMethodOcc, occNameString )
 import Module	( Module )
 import Unify	( unifyTyListsX, matchTys )
-import HscTypes	( ModDetails(..), lookupTypeEnv )
+import HscTypes	( ModDetails(..), InstEnv, lookupTypeEnv, TyThing(..),
+		  GlobalSymbolTable )
 import Unique	( pprUnique10, Unique, Uniquable(..) )
 import UniqFM
 import Unique	( Uniquable(..) )
@@ -71,6 +73,7 @@ import SrcLoc	( SrcLoc )
 import FastString	( FastString )
 import Maybes
 import Outputable
+import IOExts	( newIORef )
 \end{code}
 
 %************************************************************************
@@ -140,7 +143,7 @@ data TcTyThing
 
 initTcEnv :: GlobalSymbolTable -> InstEnv -> IO TcEnv
 initTcEnv gst inst_env
-  = do { gtv_var <- newIORef emptyVarSet
+  = do { gtv_var <- newIORef emptyVarSet ;
 	 return (TcEnv { tcGST    = gst,
 		      	 tcGEnv   = emptyNameEnv,
 		      	 tcInsts  = inst_env,
@@ -182,7 +185,7 @@ lookup_local env name
   = case lookupNameEnv (tcLEnv env) name of
 	Just thing -> Just thing
 	Nothing    -> case lookup_global env name of
-			Just thing -> AGlobal thing
+			Just thing -> Just (AGlobal thing)
 			Nothing	   -> Nothing
 
 explicitLookupId :: TcEnv -> Name -> Maybe Id
@@ -262,7 +265,7 @@ newDFunName mod clas (ty:_) loc
     tcGetUnique			`thenNF_Tc` \ uniq ->
     returnNF_Tc (mkGlobalName uniq mod
 			      (mkDFunOcc dfun_string inst_uniq) 
-			      (LocalDef loc Exported))
+			      loc)
   where
 	-- Any string that is somewhat unique will do
     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
@@ -272,7 +275,7 @@ newDefaultMethodName op_name loc
   = tcGetUnique			`thenNF_Tc` \ uniq ->
     returnNF_Tc (mkGlobalName uniq (nameModule op_name)
 			      (mkDefaultMethodOcc (getOccName op_name))
-			      (LocalDef loc Exported))
+			      loc)
 \end{code}
 
 
@@ -308,6 +311,7 @@ A variety of global lookups, when we know what we are looking for.
 
 \begin{code}
 tcLookupGlobal :: Name -> NF_TcM TyThing
+tcLookupGlobal name
   = tcLookupGlobal_maybe name	`thenNF_Tc` \ maybe_thing ->
     case maybe_thing of
 	Just thing -> returnNF_Tc thing
@@ -317,7 +321,7 @@ tcLookupGlobalId :: Name -> NF_TcM Id
 tcLookupGlobalId name
   = tcLookupGlobal_maybe name	`thenNF_Tc` \ maybe_id ->
     case maybe_id of
-	Just (AnId clas) -> returnNF_Tc id
+	Just (AnId clas) -> returnNF_Tc clas
 	other		 -> notFound "tcLookupGlobalId:" name
 	
 tcLookupDataCon :: Name -> TcM DataCon