X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=be1ce9b96440208f4f62719b38df2da3c2f01ccd;hb=e656c6e3aaa827c51cd39c9cd9f0a6461db1d4c2;hp=497ba235da4b754d889c5220ffa202b360a7b112;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 497ba23..be1ce9b 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -11,7 +11,7 @@ module TcEnv(
 	tcExtendGlobalEnv, 
 	tcExtendGlobalValEnv,
 	tcLookupLocatedGlobal,	tcLookupGlobal, 
-	tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
+	tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
 	tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
 	tcLookupLocatedClass, 
 	
@@ -64,14 +64,11 @@ import InstEnv		( Instance, DFunId, instanceDFunId, instanceHead )
 import DataCon		( DataCon )
 import TyCon		( TyCon )
 import Class		( Class )
-import Name		( Name, NamedThing(..), getSrcLoc, nameModule, isExternalName )
+import Name		( Name, NamedThing(..), getSrcLoc, nameModule )
 import PrelNames	( thFAKE )
 import NameEnv
 import OccName		( mkDFunOcc, occNameString )
-import HscTypes		( extendTypeEnvList, lookupType,
-			  TyThing(..), tyThingId, tyThingDataCon,
-			  ExternalPackageState(..) )
-
+import HscTypes		( extendTypeEnvList, lookupType, TyThing(..), ExternalPackageState(..) )
 import SrcLoc		( SrcLoc, Located(..) )
 import Outputable
 \end{code}
@@ -107,7 +104,8 @@ tcLookupGlobal name
 	 
 		-- Try global envt
 	{ (eps,hpt) <- getEpsAndHpt
-	; case lookupType hpt (eps_PTE eps) name of  {
+	; dflags <- getDOpts
+	; case lookupType dflags hpt (eps_PTE eps) name of  {
 	    Just thing -> return thing ;
 	    Nothing    -> do
 
@@ -121,16 +119,19 @@ tcLookupGlobal name
 		tcImportDecl name	-- Go find it in an interface
 	}}}}}
 
-tcLookupGlobalId :: Name -> TcM Id
--- Never used for Haskell-source DataCons, hence no ADataCon case
-tcLookupGlobalId name
+tcLookupField :: Name -> TcM Id		-- Returns the selector Id
+tcLookupField name
   = tcLookupGlobal name		`thenM` \ thing ->
-    return (tyThingId thing)
+    case thing of
+	AnId id -> return id
+	other	-> wrongThingErr "field name" (AGlobal thing) name
 
 tcLookupDataCon :: Name -> TcM DataCon
-tcLookupDataCon con_name
-  = tcLookupGlobal con_name	`thenM` \ thing ->
-    return (tyThingDataCon thing)
+tcLookupDataCon name
+  = tcLookupGlobal name	`thenM` \ thing ->
+    case thing of
+	ADataCon con -> return con
+	other	     -> wrongThingErr "data constructor" (AGlobal thing) name
 
 tcLookupClass :: Name -> TcM Class
 tcLookupClass name
@@ -387,6 +388,8 @@ find_thing ignore_it tidy_env (ATyVar tv ty)
 	bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
     in
     returnM (tidy_env1, Just msg)
+
+find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
 \end{code}
 
 \begin{code}