[project @ 2002-04-11 12:03:29 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs
index 63f91ae..f80e2db 100644 (file)
@@ -5,76 +5,70 @@ module TcEnv(
 
        -- Getting stuff from the environment
        TcEnv, initTcEnv, 
-       tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
-       getTcGST, getTcGEnv,
+       tcEnvTyCons, tcEnvClasses, tcEnvIds, tcLEnvElts,
+       getTcGEnv,
        
-       -- Instance environment
+       -- Instance environment, and InstInfo type
        tcGetInstEnv, tcSetInstEnv, 
+       InstInfo(..), pprInstInfo,
+       simpleInstInfoTy, simpleInstInfoTyCon, 
 
        -- Global environment
-       tcExtendGlobalEnv, tcExtendGlobalValEnv, 
+       tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
        tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
-       tcLookupGlobal_maybe, tcLookupGlobal,
+       tcLookupGlobal_maybe, tcLookupGlobal, 
 
        -- Local environment
-       tcExtendKindEnv, 
-       tcExtendTyVarEnv, tcExtendTyVarEnvForMeths, 
-       tcExtendLocalValEnv, tcLookup,
+       tcExtendKindEnv,  tcInLocalScope,
+       tcExtendTyVarEnv,    tcExtendTyVarEnv2, 
+       tcExtendLocalValEnv, tcExtendLocalValEnv2, 
+       tcLookup, tcLookupLocalIds, tcLookup_maybe, tcLookupId,
 
        -- Global type variables
-       tcGetGlobalTyVars, tcExtendGlobalTyVars,
+       tcGetGlobalTyVars,
 
        -- Random useful things
-       tcAddImportedIdInfo, tcInstId,
+       RecTcEnv, tcLookupRecId, tcLookupRecId_maybe, 
 
        -- New Ids
-       newLocalId, newSpecPragmaId,
-       newDefaultMethodName, newDFunName,
+       newLocalName, newDFunName,
 
-       -- ???
-       tcSetEnv, explicitLookupId
+       -- Misc
+       isLocalThing, tcSetEnv
   ) where
 
 #include "HsVersions.h"
 
+import RnHsSyn         ( RenamedMonoBinds, RenamedSig )
 import TcMonad
-import TcType          ( TcKind,  TcType, TcTyVar, TcTyVarSet, TcThetaType,
-                         tcInstTyVars, zonkTcTyVars,
-                       )
-import Id              ( mkUserLocal, isDataConWrapId_maybe )
-import IdInfo          ( vanillaIdInfo )
-import MkId            ( mkSpecPragmaId )
-import Var             ( TyVar, Id, setVarName,
-                         idType, lazySetIdInfo, idInfo, tyVarKind, UVar,
+import TcMType         ( zonkTcTyVarsAndFV )
+import TcType          ( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet, 
+                         tyVarsOfTypes, tcSplitDFunTy,
+                         getDFunTyKey, tcTyConAppTyCon
                        )
+import Id              ( idName, isDataConWrapId_maybe )
+import Var             ( TyVar, Id, idType )
 import VarSet
-import Type            ( Kind, Type, superKind,
-                         tyVarsOfType, tyVarsOfTypes,
-                         splitForAllTys, splitRhoTy, splitFunTys,
-                         splitAlgTyConApp_maybe, getTyVar, getDFunTyKey
-                       )
 import DataCon         ( DataCon )
-import TyCon           ( TyCon, tyConKind, tyConArity, isSynTyCon )
-import Class           ( Class, ClassOpItem, ClassContext, classTyCon )
-import Subst           ( substTy )
-import Name            ( Name, OccName, NamedThing(..), 
-                         nameOccName, nameModule, getSrcLoc, mkGlobalName,
-                         isLocallyDefined,
-                         NameEnv, emptyNameEnv, lookupNameEnv, nameEnvElts, 
-                         extendNameEnv, extendNameEnvList
+import TyCon           ( TyCon, DataConDetails )
+import Class           ( Class, ClassOpItem )
+import Name            ( Name, NamedThing(..), 
+                         getSrcLoc, mkInternalName, isInternalName, nameIsLocalOrFrom
+                       )
+import NameEnv         ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
+                         extendNameEnvList, emptyNameEnv, plusNameEnv )
+import OccName         ( mkDFunOcc, occNameString )
+import HscTypes                ( DFunId, 
+                         PackageTypeEnv, TypeEnv, 
+                         extendTypeEnvList, extendTypeEnvWithIds,
+                         typeEnvTyCons, typeEnvClasses, typeEnvIds,
+                         HomeSymbolTable
                        )
-import OccName         ( mkDFunOcc, mkDefaultMethodOcc, occNameString )
 import Module          ( Module )
-import HscTypes                ( ModDetails(..), InstEnv, lookupTypeEnv, TyThing(..),
-                         GlobalSymbolTable, Provenance(..) )
-import Unique          ( pprUnique10, Unique, Uniquable(..) )
-import UniqFM
-import Unique          ( Uniquable(..) )
-import Util            ( zipEqual, zipWith3Equal, mapAccumL )
+import InstEnv         ( InstEnv, emptyInstEnv )
+import HscTypes                ( lookupType, TyThing(..) )
 import SrcLoc          ( SrcLoc )
-import FastString      ( FastString )
 import Outputable
-import TcInstUtil      ( emptyInstEnv )
 
 import IOExts          ( newIORef )
 \end{code}
@@ -91,15 +85,16 @@ type TcIdSet = IdSet
 
 data TcEnv
   = TcEnv {
-       tcGST    :: GlobalSymbolTable,  -- The symbol table at the moment we began this compilation
+       tcGST    :: Name -> Maybe TyThing,      -- The type environment at the moment we began this compilation
 
        tcInsts  :: InstEnv,            -- All instances (both imported and in this module)
 
-       tcGEnv   :: NameEnv TyThing,    -- The global type environment we've accumulated while
-                   {- TypeEnv -}       -- compiling this module:
+       tcGEnv   :: TypeEnv,            -- The global type environment we've accumulated while
+                {- NameEnv TyThing-}   -- compiling this module:
                                        --      types and classes (both imported and local)
                                        --      imported Ids
-                                       -- (Ids defined in this module are in the local envt)
+                                       -- (Ids defined in this module start in the local envt, 
+                                       --  though they move to the global envt during zonking)
 
        tcLEnv   :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
                                        -- defined in this module
@@ -132,44 +127,55 @@ 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 :: GlobalSymbolTable -> IO TcEnv
-initTcEnv gst
+initTcEnv :: HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
+initTcEnv hst pte 
   = do { gtv_var <- newIORef emptyVarSet ;
-        return (TcEnv { tcGST    = gst,
+        return (TcEnv { tcGST    = lookup,
                         tcGEnv   = emptyNameEnv,
                         tcInsts  = emptyInstEnv,
                         tcLEnv   = emptyNameEnv,
                         tcTyVars = gtv_var
         })}
+  where
+    lookup name | isInternalName name = Nothing
+               | 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)] 
-tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
-tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 
-getTcGST  (TcEnv { tcGST = gst })   = gst
+tcEnvClasses env = typeEnvClasses (tcGEnv env)
+tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env) 
+tcEnvIds     env = typeEnvIds     (tcGEnv env) 
+tcLEnvElts   env = nameEnvElts (tcLEnv env)
+
 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 
--- This data type is used to help tie the knot
--- when type checking type and class declarations
-data TyThingDetails = SynTyDetails Type
-                   | DataTyDetails ClassContext [DataCon] [Class]
-                   | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
+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
+
+\begin{code}
+data TyThingDetails = SynTyDetails Type
+                   | DataTyDetails ThetaType (DataConDetails DataCon) [Id]
+                   | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
+                   | ForeignTyDetails  -- Nothing yet
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -183,7 +189,7 @@ lookup_global :: TcEnv -> Name -> Maybe TyThing
 lookup_global env name 
   = case lookupNameEnv (tcGEnv env) name of
        Just thing -> Just thing
-       Nothing    -> lookupTypeEnv (tcGST env) name
+       Nothing    -> tcGST env name
 
 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
        -- Try the local envt and then try the global
@@ -193,55 +199,25 @@ lookup_local env name
        Nothing    -> case lookup_global env name of
                        Just thing -> Just (AGlobal thing)
                        Nothing    -> Nothing
-
-explicitLookupId :: TcEnv -> Name -> Maybe Id
-explicitLookupId env name = case lookup_global env name of
-                               Just (AnId id) -> Just id
-                               other          -> Nothing
 \end{code}
 
-
-%************************************************************************
-%*                                                                     *
-\subsection{Random useful functions}
-%*                                                                     *
-%************************************************************************
-
-
 \begin{code}
--- A useful function that takes an occurrence of a global thing
--- and instantiates its type with fresh type variables
-tcInstId :: Id
-        -> NF_TcM ([TcTyVar],  -- It's instantiated type
-                     TcThetaType,      --
-                     TcType)           --
-tcInstId id
-  = let
-      (tyvars, rho) = splitForAllTys (idType id)
-    in
-    tcInstTyVars tyvars                `thenNF_Tc` \ (tyvars', arg_tys, tenv) ->
-    let
-       rho'           = substTy tenv rho
-       (theta', tau') = splitRhoTy rho' 
-    in
-    returnNF_Tc (tyvars', theta', tau')
-
-tcAddImportedIdInfo :: TcEnv -> Id -> Id
-tcAddImportedIdInfo unf_env id
-  | isLocallyDefined id                -- Don't look up locally defined Ids, because they
-                               -- have explicit local definitions, so we get a black hole!
-  = id
-  | otherwise
-  = id `lazySetIdInfo` new_info
-       -- The Id must be returned without a data dependency on maybe_id
-  where
-    new_info = case explicitLookupId unf_env (getName id) of
-                    Nothing          -> vanillaIdInfo
-                    Just imported_id -> idInfo imported_id
-               -- ToDo: could check that types are the same
+type RecTcEnv = TcEnv
+-- This environment is used for getting the 'right' IdInfo 
+-- on imported things and for looking up Ids in unfoldings
+-- The environment doesn't have any local Ids in it
+
+tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
+tcLookupRecId_maybe env name = case lookup_global env name of
+                                  Just (AnId id) -> Just id
+                                  other          -> Nothing
+
+tcLookupRecId ::  RecTcEnv -> Name -> Id
+tcLookupRecId env name = case lookup_global env name of
+                               Just (AnId id) -> id
+                               Nothing        -> pprPanic "tcLookupRecId" (ppr name)
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Making new Ids}
@@ -251,39 +227,32 @@ tcAddImportedIdInfo unf_env id
 Constructing new Ids
 
 \begin{code}
-newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
-newLocalId name ty loc
+newLocalName :: Name -> NF_TcM Name
+newLocalName name      -- Make a clone
   = tcGetUnique                `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkUserLocal name uniq ty loc)
-
-newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
-newSpecPragmaId name ty 
-  = tcGetUnique                `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
+    returnNF_Tc (mkInternalName uniq (getOccName name) (getSrcLoc name))
 \end{code}
 
-Make a name for the dict fun for an instance decl
+Make a name for the dict fun for an instance decl.
+It's a *local* name for the moment.  The CoreTidy pass
+will externalise it.
 
 \begin{code}
-newDFunName :: Module -> Class -> [Type] -> SrcLoc -> NF_TcM Name
-newDFunName mod clas (ty:_) loc
-  = tcGetDFunUniq dfun_string  `thenNF_Tc` \ inst_uniq ->
-    tcGetUnique                        `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkGlobalName uniq mod
-                             (mkDFunOcc dfun_string inst_uniq) 
-                             loc)
+newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
+newDFunName clas (ty:_) loc
+  = tcGetUnique                        `thenNF_Tc` \ uniq ->
+    returnNF_Tc (mkInternalName uniq (mkDFunOcc dfun_string) loc)
   where
        -- Any string that is somewhat unique will do
     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 
-newDefaultMethodName :: Name -> SrcLoc -> NF_TcM Name
-newDefaultMethodName op_name loc
-  = tcGetUnique                        `thenNF_Tc` \ uniq ->
-    returnNF_Tc (mkGlobalName uniq (nameModule op_name)
-                             (mkDefaultMethodOcc (getOccName op_name))
-                             loc)
+newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 \end{code}
 
+\begin{code}
+isLocalThing :: NamedThing a => Module -> a -> Bool
+isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -292,17 +261,30 @@ newDefaultMethodName op_name loc
 %************************************************************************
 
 \begin{code}
-tcExtendGlobalEnv :: [(Name, TyThing)] -> TcM r -> TcM r
-tcExtendGlobalEnv bindings thing_inside
+tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
+tcExtendGlobalEnv things thing_inside
+  = tcGetEnv                           `thenNF_Tc` \ env ->
+    let
+       ge' = extendTypeEnvList (tcGEnv env) things
+    in
+    tcSetEnv (env {tcGEnv = ge'}) thing_inside
+
+
+tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
+tcExtendGlobalTypeEnv extra_env thing_inside
   = tcGetEnv                           `thenNF_Tc` \ env ->
     let
-       ge' = extendNameEnvList (tcGEnv env) bindings
+       ge' = tcGEnv env `plusNameEnv` extra_env
     in
     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 
 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 tcExtendGlobalValEnv ids thing_inside
-  = tcExtendGlobalEnv [(getName id, AnId id) | id <- ids] thing_inside
+  = tcGetEnv                           `thenNF_Tc` \ env ->
+    let
+       ge' = extendTypeEnvWithIds (tcGEnv env) ids
+    in
+    tcSetEnv (env {tcGEnv = ge'}) thing_inside
 \end{code}
 
 
@@ -321,14 +303,14 @@ tcLookupGlobal name
   = tcLookupGlobal_maybe name  `thenNF_Tc` \ maybe_thing ->
     case maybe_thing of
        Just thing -> returnNF_Tc thing
-       other      -> notFound "tcLookupGlobal:" name
+       other      -> notFound "tcLookupGlobal" name
 
 tcLookupGlobalId :: Name -> NF_TcM Id
 tcLookupGlobalId name
   = tcLookupGlobal_maybe name  `thenNF_Tc` \ maybe_id ->
     case maybe_id of
-       Just (AnId clas) -> returnNF_Tc clas
-       other            -> notFound "tcLookupGlobalId:" name
+       Just (AnId id) -> returnNF_Tc id
+       other          -> notFound "tcLookupGlobalId" name
        
 tcLookupDataCon :: Name -> TcM DataCon
 tcLookupDataCon con_name
@@ -343,14 +325,31 @@ tcLookupClass name
   = tcLookupGlobal_maybe name  `thenNF_Tc` \ maybe_clas ->
     case maybe_clas of
        Just (AClass clas) -> returnNF_Tc clas
-       other              -> notFound "tcLookupClass:" name
+       other              -> notFound "tcLookupClass" name
        
 tcLookupTyCon :: Name -> NF_TcM TyCon
 tcLookupTyCon name
   = tcLookupGlobal_maybe name  `thenNF_Tc` \ maybe_tc ->
     case maybe_tc of
        Just (ATyCon tc) -> returnNF_Tc tc
-       other            -> notFound "tcLookupTyCon:" name
+       other            -> notFound "tcLookupTyCon" name
+
+tcLookupId :: Name -> NF_TcM Id
+tcLookupId name
+  = tcLookup name      `thenNF_Tc` \ thing -> 
+    case thing of
+       ATcId tc_id       -> returnNF_Tc tc_id
+       AGlobal (AnId id) -> returnNF_Tc id
+       other             -> pprPanic "tcLookupId" (ppr name)
+
+tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
+tcLookupLocalIds ns
+  = tcGetEnv           `thenNF_Tc` \ env ->
+    returnNF_Tc (map (lookup (tcLEnv env)) ns)
+  where
+    lookup lenv name = case lookupNameEnv lenv name of
+                       Just (ATcId id) -> id
+                       other           -> pprPanic "tcLookupLocalIds" (ppr name)
 \end{code}
 
 
@@ -371,7 +370,7 @@ tcLookup name
   = tcLookup_maybe name                `thenNF_Tc` \ maybe_thing ->
     case maybe_thing of
        Just thing -> returnNF_Tc thing
-       other      -> notFound "tcLookup:" name
+       other      -> notFound "tcLookup" name
        -- Extract the IdInfo from an IfaceSig imported from an interface file
 \end{code}
 
@@ -387,10 +386,19 @@ tcExtendKindEnv pairs thing_inside
     tcSetEnv (env {tcLEnv = le'}) thing_inside
     
 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
-tcExtendTyVarEnv tyvars thing_inside
+tcExtendTyVarEnv tvs thing_inside
+  = tc_extend_tv_env [(getName tv, ATyVar tv) | tv <- tvs] tvs thing_inside
+
+tcExtendTyVarEnv2 :: [(TyVar,TcTyVar)] -> TcM r -> TcM r
+tcExtendTyVarEnv2 tv_pairs thing_inside
+  = tc_extend_tv_env [(getName tv1, ATyVar tv2) | (tv1,tv2) <- tv_pairs]
+                    [tv | (_,tv) <- tv_pairs]
+                    thing_inside
+
+tc_extend_tv_env binds tyvars thing_inside
   = tcGetEnv                   `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
     let
-       le'        = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
+       le'        = extendNameEnvList le binds
        new_tv_set = mkVarSet tyvars
     in
        -- It's important to add the in-scope tyvars to the global tyvar set
@@ -401,29 +409,23 @@ tcExtendTyVarEnv tyvars thing_inside
        -- when typechecking the methods.
     tc_extend_gtvs gtvs new_tv_set             `thenNF_Tc` \ gtvs' ->
     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
+\end{code}
 
--- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
---     the signature tyvars contain the original names
---     the instance  tyvars are what those names should be mapped to
--- It's needed when typechecking the method bindings of class and instance decls
--- It does *not* extend the global tyvars; tcMethodBind does that for itself
 
-tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
-tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
-  = tcGetEnv                                   `thenNF_Tc` \ env ->
+\begin{code}
+tcExtendLocalValEnv :: [TcId] -> TcM a -> TcM a
+tcExtendLocalValEnv ids thing_inside
+  = tcGetEnv           `thenNF_Tc` \ env ->
     let
-       le'   = extendNameEnvList (tcLEnv env) stuff
-       stuff = [ (getName sig_tv, ATyVar inst_tv)
-               | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
-               ]
+       extra_global_tyvars = tyVarsOfTypes [idType id | id <- ids]
+       extra_env           = [(idName id, ATcId id) | id <- ids]
+       le'                 = extendNameEnvList (tcLEnv env) extra_env
     in
-    tcSetEnv (env {tcLEnv = le'}) thing_inside
-\end{code}
-
+    tc_extend_gtvs (tcTyVars env) extra_global_tyvars  `thenNF_Tc` \ gtvs' ->
+    tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 
-\begin{code}
-tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
-tcExtendLocalValEnv names_w_ids thing_inside
+tcExtendLocalValEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
+tcExtendLocalValEnv2 names_w_ids thing_inside
   = tcGetEnv           `thenNF_Tc` \ env ->
     let
        extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
@@ -442,11 +444,6 @@ tcExtendLocalValEnv names_w_ids thing_inside
 %************************************************************************
 
 \begin{code}
-tcExtendGlobalTyVars extra_global_tvs thing_inside
-  = tcGetEnv                                           `thenNF_Tc` \ env ->
-    tc_extend_gtvs (tcTyVars env) extra_global_tvs     `thenNF_Tc` \ gtvs' ->
-    tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
-
 tc_extend_gtvs gtvs extra_global_tvs
   = tcReadMutVar gtvs                  `thenNF_Tc` \ global_tvs ->
     tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
@@ -460,13 +457,10 @@ the environment.
 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
 tcGetGlobalTyVars
   = tcGetEnv                                   `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
-    tcReadMutVar gtv_var                       `thenNF_Tc` \ global_tvs ->
-    zonkTcTyVars (varSetElems global_tvs)      `thenNF_Tc` \ global_tys' ->
-    let
-       global_tvs' = (tyVarsOfTypes global_tys')
-    in
-    tcWriteMutVar gtv_var global_tvs'          `thenNF_Tc_` 
-    returnNF_Tc global_tvs'
+    tcReadMutVar gtv_var                       `thenNF_Tc` \ gbl_tvs ->
+    zonkTcTyVarsAndFV (varSetElems gbl_tvs)    `thenNF_Tc` \ gbl_tvs' ->
+    tcWriteMutVar gtv_var gbl_tvs'             `thenNF_Tc_` 
+    returnNF_Tc gbl_tvs'
 \end{code}
 
 
@@ -490,6 +484,49 @@ tcSetInstEnv ie thing_inside
 
 %************************************************************************
 %*                                                                     *
+\subsection{The InstInfo type}
+%*                                                                     *
+%************************************************************************
+
+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 {
+      iDFunId :: DFunId,               -- The dfun id
+      iBinds  :: RenamedMonoBinds,     -- Bindings, b
+      iPrags  :: [RenamedSig]          -- User pragmas recorded for generating specialised instances
+    }
+
+  | 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
+                         (_, _, _, [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 = tcTyConAppTyCon (simpleInstInfoTy inst)
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Errors}
 %*                                                                     *
 %************************************************************************