[project @ 2001-07-13 13:29:56 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs
index 4d9dbb8..fb866a3 100644 (file)
@@ -16,10 +16,10 @@ module TcEnv(
        -- Global environment
        tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
        tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
-       tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
+       tcLookupGlobal_maybe, tcLookupGlobal, 
 
        -- Local environment
-       tcExtendKindEnv,  tcLookupLocalIds,
+       tcExtendKindEnv,  tcLookupLocalIds, tcInLocalScope,
        tcExtendTyVarEnv, tcExtendTyVarEnvForMeths, 
        tcExtendLocalValEnv, tcLookup, tcLookup_maybe, tcLookupId,
 
@@ -41,26 +41,23 @@ module TcEnv(
 
 import RnHsSyn         ( RenamedMonoBinds, RenamedSig )
 import TcMonad
-import TcType          ( TcKind,  TcType, TcTyVar, TcTyVarSet, 
-                         zonkTcTyVarsAndFV
+import TcMType         ( zonkTcTyVarsAndFV )
+import TcType          ( Type, ThetaType, 
+                         tyVarsOfTypes, tcSplitDFunTy,
+                         getDFunTyKey, tcTyConAppTyCon
                        )
-import Id              ( idName, mkUserLocal, isDataConWrapId_maybe )
-import IdInfo          ( constantIdInfo )
-import MkId            ( mkSpecPragmaId )
+import Id              ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
+import IdInfo          ( vanillaIdInfo )
 import Var             ( TyVar, Id, idType, lazySetIdInfo, idInfo )
 import VarSet
-import Type            ( Type,
-                         tyVarsOfTypes, splitDFunTy,
-                         getDFunTyKey, tyConAppTyCon
-                       )
 import DataCon         ( DataCon )
 import TyCon           ( TyCon )
-import Class           ( Class, ClassOpItem, ClassContext )
+import Class           ( Class, ClassOpItem )
 import Name            ( Name, OccName, NamedThing(..), 
                          nameOccName, getSrcLoc, mkLocalName, isLocalName,
-                         nameIsLocalOrFrom, nameModule_maybe
+                         nameIsLocalOrFrom
                        )
-import Name            ( NameEnv, lookupNameEnv, nameEnvElts, 
+import NameEnv         ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
                          extendNameEnvList, emptyNameEnv, plusNameEnv )
 import OccName         ( mkDFunOcc, occNameString )
 import HscTypes                ( DFunId, 
@@ -92,8 +89,6 @@ type TcIdSet = IdSet
 
 data TcEnv
   = TcEnv {
-       tcSyntaxMap :: PrelNames.SyntaxMap,     -- The syntax map (usually the identity)
-
        tcGST    :: Name -> Maybe TyThing,      -- The type environment at the moment we began this compilation
 
        tcInsts  :: InstEnv,            -- All instances (both imported and in this module)
@@ -148,11 +143,10 @@ data TcTyThing
 --     3. Then we zonk the kind variable.
 --     4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
 
-initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
-initTcEnv syntax_map hst pte 
+initTcEnv :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
+initTcEnv hst pte 
   = do { gtv_var <- newIORef emptyVarSet ;
-        return (TcEnv { tcSyntaxMap = syntax_map,
-                        tcGST    = lookup,
+        return (TcEnv { tcGST    = lookup,
                         tcGEnv   = emptyNameEnv,
                         tcInsts  = emptyInstEnv,
                         tcLEnv   = emptyNameEnv,
@@ -171,11 +165,15 @@ tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 
 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 
+tcInLocalScope :: TcEnv -> Name -> Bool
+tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
+
 -- This data type is used to help tie the knot
 -- when type checking type and class declarations
 data TyThingDetails = SynTyDetails Type
-                   | DataTyDetails ClassContext [DataCon] [Id]
-                   | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
+                   | DataTyDetails ThetaType [DataCon] [Id]
+                   | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
+                   | ForeignTyDetails  -- Nothing yet
 \end{code}
 
 
@@ -215,7 +213,7 @@ tcAddImportedIdInfo env id
        -- The Id must be returned without a data dependency on maybe_id
   where
     new_info = case tcLookupRecId_maybe env (idName id) of
-                 Nothing          -> pprTrace "tcAddIdInfo" (ppr id) constantIdInfo
+                 Nothing          -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
                  Just imported_id -> idInfo imported_id
                -- ToDo: could check that types are the same
 
@@ -367,21 +365,6 @@ tcLookupLocalIds ns
     lookup lenv name = case lookupNameEnv lenv name of
                        Just (ATcId id) -> id
                        other           -> pprPanic "tcLookupLocalIds" (ppr name)
-
-tcLookupSyntaxId :: Name -> NF_TcM Id
--- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
--- after mapping through the SyntaxMap.  This may give us the Id for
--- (say) MyPrelude.fromInteger
-tcLookupSyntaxId name
-  = tcGetEnv           `thenNF_Tc` \ env ->
-    returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
-                       Just (AnId id) -> id
-                       other          -> pprPanic "tcLookupSyntaxId" (ppr name))
-
-tcLookupSyntaxName :: Name -> NF_TcM Name
-tcLookupSyntaxName name
-  = tcGetEnv           `thenNF_Tc` \ env ->
-    returnNF_Tc (tcSyntaxMap env name)
 \end{code}
 
 
@@ -538,13 +521,13 @@ pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))
                         nest 4 (ppr (iBinds info))]
 
 simpleInstInfoTy :: InstInfo -> Type
-simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
+simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
                          (_, _, _, [ty]) -> ty
 
 simpleInstInfoTyCon :: InstInfo -> TyCon
   -- Gets the type constructor for a simple instance declaration,
   -- i.e. one of the form      instance (...) => C (T a b c) where ...
-simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
+simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 \end{code}