X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcEnv.lhs;h=3c63d34acbaaf99e02e5c25fee4c41c1059e7eb6;hb=937b23b94b458172442ac583f8d5b6f5a093a24b;hp=fe0cac9de1561cb0b27211ec38f5d6dc7e94dcdd;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index fe0cac9..3c63d34 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -21,7 +21,7 @@ module TcEnv(
 	tcLookupValueByKey, tcLookupValueByKeyMaybe,
 	explicitLookupValueByKey, explicitLookupValue,
 
-	newLocalIds, newLocalId, newSpecPragmaId,
+	newLocalId, newSpecPragmaId,
 	tcGetGlobalTyVars, tcExtendGlobalTyVars,
 
 	badCon, badPrimOp
@@ -54,9 +54,8 @@ import TcMonad
 
 import BasicTypes	( Arity )
 import IdInfo		( noIdInfo )
-import Name		( Name, OccName, nameOccName, occNameString, mkLocalName,
+import Name		( Name, OccName, nameOccName, getSrcLoc,
 			  maybeWiredInTyConName, maybeWiredInIdName, isLocallyDefined,
-			  isSysLocalName,
 			  NamedThing(..)
 			)
 import Unique		( pprUnique10, Unique, Uniquable(..) )
@@ -66,6 +65,7 @@ import Unique		( Uniquable(..) )
 import Util		( zipEqual, zipWith3Equal, mapAccumL )
 import Bag		( bagToList )
 import Maybes		( maybeToBool )
+import SrcLoc		( SrcLoc )
 import FastString	( FastString )
 import Outputable
 \end{code}
@@ -265,7 +265,9 @@ tcLookupTy name
 		   maybe_arity | isSynTyCon tc = Just (tyConArity tc)
 			       | otherwise     = Nothing 
 
-	Nothing -> pprPanic "tcLookupTy" (ppr name)
+	Nothing -> 	-- This can happen if an interface-file
+			-- unfolding is screwed up
+		   failWithTc (tyNameOutOfScope name)
     }
 	
 tcLookupClass :: Name -> NF_TcM s Class
@@ -399,24 +401,15 @@ tcAddImportedIdInfo unf_env id
 %************************************************************************
 
 \begin{code}
-newLocalId :: OccName -> TcType -> NF_TcM s TcId
-newLocalId name ty
+newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM s TcId
+newLocalId name ty loc
   = tcGetUnique		`thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkUserLocal name uniq ty)
-
-newLocalIds :: [OccName] -> [TcType] -> NF_TcM s [TcId]
-newLocalIds names tys
-  = tcGetUniques (length names) `thenNF_Tc` \ uniqs ->
-    let
-	new_ids            = zipWith3Equal "newLocalIds" mk_id names uniqs tys
-	mk_id name uniq ty = mkUserLocal name uniq ty
-    in
-    returnNF_Tc new_ids
+    returnNF_Tc (mkUserLocal name uniq ty loc)
 
 newSpecPragmaId :: Name -> TcType -> NF_TcM s TcId
 newSpecPragmaId name ty 
   = tcGetUnique		`thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty)
+    returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
 \end{code}
 
 
@@ -431,4 +424,7 @@ badCon con_id
   = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 badPrimOp op
   = quotes (ppr op) <+> ptext SLIT("is not a primop")
+
+tyNameOutOfScope name
+  = quotes (ppr name) <+> ptext SLIT("is not in scope")
 \end{code}