[project @ 2001-12-20 11:19:05 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs
index fb866a3..744fb42 100644 (file)
@@ -5,7 +5,7 @@ module TcEnv(
 
        -- Getting stuff from the environment
        TcEnv, initTcEnv, 
-       tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
+       tcEnvTyCons, tcEnvClasses, tcEnvIds, tcLEnvElts,
        getTcGEnv,
        
        -- Instance environment, and InstInfo type
@@ -27,11 +27,10 @@ module TcEnv(
        tcGetGlobalTyVars, tcExtendGlobalTyVars,
 
        -- Random useful things
-       RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe, 
+       RecTcEnv, tcLookupRecId, tcLookupRecId_maybe, 
 
        -- New Ids
-       newLocalId, newSpecPragmaId,
-       newDFunName,
+       newLocalName, newDFunName,
 
        -- Misc
        isLocalThing, tcSetEnv
@@ -42,20 +41,19 @@ module TcEnv(
 import RnHsSyn         ( RenamedMonoBinds, RenamedSig )
 import TcMonad
 import TcMType         ( zonkTcTyVarsAndFV )
-import TcType          ( Type, ThetaType, 
+import TcType          ( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet, 
                          tyVarsOfTypes, tcSplitDFunTy,
                          getDFunTyKey, tcTyConAppTyCon
                        )
-import Id              ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
+import Id              ( idName, isDataConWrapId_maybe )
 import IdInfo          ( vanillaIdInfo )
 import Var             ( TyVar, Id, idType, lazySetIdInfo, idInfo )
 import VarSet
 import DataCon         ( DataCon )
 import TyCon           ( TyCon )
 import Class           ( Class, ClassOpItem )
-import Name            ( Name, OccName, NamedThing(..), 
-                         nameOccName, getSrcLoc, mkLocalName, isLocalName,
-                         nameIsLocalOrFrom
+import Name            ( Name, NamedThing(..), 
+                         getSrcLoc, mkLocalName, isLocalName, nameIsLocalOrFrom
                        )
 import NameEnv         ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
                          extendNameEnvList, emptyNameEnv, plusNameEnv )
@@ -71,7 +69,6 @@ import InstEnv                ( InstEnv, emptyInstEnv )
 import HscTypes                ( lookupType, TyThing(..) )
 import Util            ( zipEqual )
 import SrcLoc          ( SrcLoc )
-import qualified PrelNames 
 import Outputable
 
 import IOExts          ( newIORef )
@@ -131,18 +128,6 @@ used thus:
 
 
 \begin{code}
-data TcTyThing
-  = AGlobal TyThing    -- Used only in the return type of a lookup
-  | ATcId  TcId                -- Ids defined in this module
-  | ATyVar TyVar       -- Type variables
-  | AThing TcKind      -- Used temporarily, during kind checking
--- Here's an example of how the AThing guy is used
--- Suppose we are checking (forall a. T a Int):
---     1. We first bind (a -> AThink kv), where kv is a kind variable. 
---     2. Then we kind-check the (T a Int) part.
---     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 
   = do { gtv_var <- newIORef emptyVarSet ;
@@ -160,23 +145,39 @@ initTcEnv hst pte
 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)]
+tcLEnvElts   env = nameEnvElts (tcLEnv env)
 
 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 
 tcInLocalScope :: TcEnv -> Name -> Bool
 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
+\end{code}
+
+\begin{code}
+data TcTyThing
+  = AGlobal TyThing            -- Used only in the return type of a lookup
+  | ATcId   TcId               -- Ids defined in this module
+  | ATyVar  TyVar              -- Type variables
+  | AThing  TcKind             -- Used temporarily, during kind checking
+-- Here's an example of how the AThing guy is used
+-- Suppose we are checking (forall a. T a Int):
+--     1. We first bind (a -> AThink kv), where kv is a kind variable. 
+--     2. Then we kind-check the (T a Int) part.
+--     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
+
+\end{code}
+
+This data type is used to help tie the knot
+ when type checking type and class declarations
 
--- This data type is used to help tie the knot
--- when type checking type and class declarations
+\begin{code}
 data TyThingDetails = SynTyDetails Type
                    | DataTyDetails ThetaType [DataCon] [Id]
                    | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
                    | ForeignTyDetails  -- Nothing yet
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Basic lookups}
@@ -207,16 +208,6 @@ type RecTcEnv = TcEnv
 -- on imported things and for looking up Ids in unfoldings
 -- The environment doesn't have any local Ids in it
 
-tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
-tcAddImportedIdInfo env id
-  = id `lazySetIdInfo` new_info
-       -- 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) vanillaIdInfo
-                 Just imported_id -> idInfo imported_id
-               -- ToDo: could check that types are the same
-
 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
 tcLookupRecId_maybe env name = case lookup_global env name of
                                   Just (AnId id) -> Just id
@@ -237,15 +228,10 @@ tcLookupRecId env name = case lookup_global env name of
 Constructing new Ids
 
 \begin{code}
-newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
-newLocalId name ty loc
-  = tcGetUnique                `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkUserLocal name uniq ty loc)
-
-newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
-newSpecPragmaId name ty 
+newLocalName :: Name -> NF_TcM Name
+newLocalName name      -- Make a clone
   = tcGetUnique                `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
+    returnNF_Tc (mkLocalName uniq (getOccName name) (getSrcLoc name))
 \end{code}
 
 Make a name for the dict fun for an instance decl.
@@ -509,6 +495,12 @@ The InstInfo type summarises the information in an instance declaration
 
     instance c => k (t tvs) where b
 
+It is used just for *local* instance decls (not ones from interface files).
+But local instance decls includes
+       - derived ones
+       - generic ones
+as well as explicit user written ones.
+
 \begin{code}
 data InstInfo
   = InstInfo {
@@ -517,8 +509,13 @@ data InstInfo
       iPrags  :: [RenamedSig]          -- User pragmas recorded for generating specialised instances
     }
 
-pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
-                        nest 4 (ppr (iBinds info))]
+  | NewTypeDerived {           -- Used for deriving instances of newtypes, where the
+                               -- witness dictionary is identical to the argument dictionary
+                               -- Hence no bindings.
+      iDFunId :: DFunId                        -- The dfun id
+    }
+
+pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
 
 simpleInstInfoTy :: InstInfo -> Type
 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of