[project @ 2001-02-23 14:59:26 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 f89e31a..cbd92f8 100644 (file)
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -16,7 +16,7 @@ module TcEnv(
        -- Global environment
        tcExtendGlobalEnv, tcExtendGlobalValEnv, 
        tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
-       tcLookupGlobal_maybe, tcLookupGlobal, 
+       tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
 
        -- Local environment
        tcExtendKindEnv,  tcLookupLocalIds,
@@ -57,17 +57,20 @@ import DataCon              ( DataCon )
 import TyCon           ( TyCon )
 import Class           ( Class, ClassOpItem, ClassContext )
 import Name            ( Name, OccName, NamedThing(..), 
-                         nameOccName, getSrcLoc, mkLocalName,
-                         isLocalName, nameModule_maybe
+                         nameOccName, getSrcLoc, mkLocalName, isLocalName,
+                         nameIsLocalOrFrom, nameModule_maybe
                        )
 import Name            ( NameEnv, lookupNameEnv, nameEnvElts, extendNameEnvList, emptyNameEnv )
 import OccName         ( mkDFunOcc, occNameString )
-import HscTypes                ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv )
+import HscTypes                ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv,
+                         typeEnvTyCons, typeEnvClasses, typeEnvIds
+                       )
 import Module          ( Module )
 import InstEnv         ( InstEnv, emptyInstEnv )
 import HscTypes                ( lookupType, TyThing(..) )
 import Util            ( zipEqual )
 import SrcLoc          ( SrcLoc )
+import qualified PrelNames 
 import Outputable
 
 import IOExts          ( newIORef )
@@ -85,6 +88,8 @@ 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)
@@ -138,10 +143,11 @@ 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 :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
-initTcEnv hst pte 
+initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
+initTcEnv syntax_map hst pte 
   = do { gtv_var <- newIORef emptyVarSet ;
-        return (TcEnv { tcGST    = lookup,
+        return (TcEnv { tcSyntaxMap = syntax_map,
+                        tcGST    = lookup,
                         tcGEnv   = emptyNameEnv,
                         tcInsts  = emptyInstEnv,
                         tcLEnv   = emptyNameEnv,
@@ -152,9 +158,9 @@ initTcEnv hst pte
                | otherwise        = lookupType hst pte name
 
 
-tcEnvClasses env = [cl | AClass cl <- nameEnvElts (tcGEnv env)]
-tcEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts (tcGEnv env)] 
-tcEnvIds     env = [id | AnId   id <- nameEnvElts (tcGEnv env)] 
+tcEnvClasses env = typeEnvClasses (tcGEnv env)
+tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env) 
+tcEnvIds     env = typeEnvIds     (tcGEnv env) 
 tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
 tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 
@@ -257,11 +263,7 @@ newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 
 \begin{code}
 isLocalThing :: NamedThing a => Module -> a -> Bool
-  -- True if the thing has a Local name, 
-  -- or a Global name from the specified module
-isLocalThing mod thing = case nameModule_maybe (getName thing) of
-                          Nothing -> True      -- A local name
-                          Just m  -> m == mod  -- A global thing
+isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
 \end{code}
 
 %************************************************************************
@@ -343,6 +345,21 @@ 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}
 
 
@@ -490,7 +507,6 @@ The InstInfo type summarises the information in an instance declaration
 \begin{code}
 data InstInfo
   = InstInfo {
-      iLocal  :: Bool,                 -- True <=> it's defined in this module
       iDFunId :: DFunId,               -- The dfun id
       iBinds  :: RenamedMonoBinds,     -- Bindings, b
       iPrags  :: [RenamedSig]          -- User pragmas recorded for generating specialised instances