[project @ 1999-02-04 13:45:24 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index fe0cac9..3c63d34 100644 (file)
--- 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}