[project @ 2005-01-18 12:18:11 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 50f5c2b..5ebfe58 100644 (file)
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -17,7 +17,7 @@ module TcEnv(
        
        -- Local environment
        tcExtendKindEnv,
-       tcExtendTyVarEnv, tcExtendTyVarEnv2, tcExtendTyVarEnv3, 
+       tcExtendTyVarEnv, tcExtendTyVarEnv2, 
        tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
        tcLookup, tcLookupLocated, tcLookupLocalIds,
        tcLookupId, tcLookupTyVar,
@@ -48,15 +48,15 @@ module TcEnv(
 import HsSyn           ( LRuleDecl, LHsBinds, LSig, pprLHsBinds )
 import TcIface         ( tcImportDecl )
 import TcRnMonad
-import TcMType         ( zonkTcType, zonkTcTyVar, zonkTcTyVarsAndFV )
+import TcMType         ( zonkTcType, zonkTcTyVarsAndFV )
 import TcType          ( Type, TcKind, TcTyVar, TcTyVarSet, TcType,
                          tyVarsOfType, tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
                          getDFunTyKey, tcTyConAppTyCon, tcGetTyVar, mkTyVarTy,
-                         tidyOpenType, tidyOpenTyVar, pprTyThingCategory
+                         tidyOpenType, pprTyThingCategory
                        )
 import qualified Type  ( getTyVar_maybe )
 import Id              ( idName, isLocalId )
-import Var             ( TyVar, Id, idType )
+import Var             ( TyVar, Id, idType, tyVarName )
 import VarSet
 import VarEnv
 import RdrName         ( extendLocalRdrEnv )
@@ -105,8 +105,7 @@ tcLookupGlobal name
        { (eps,hpt) <- getEpsAndHpt
        ; case lookupType hpt (eps_PTE eps) name of 
            Just thing -> return thing 
-           Nothing    -> do { traceIf (text "tcLookupGlobal" <+> ppr name)
-                            ; initIfaceTcRn (tcImportDecl name) }
+           Nothing    -> tcImportDecl name
     }}
 \end{code}
 
@@ -248,25 +247,17 @@ tcExtendKindEnv things thing_inside
 
 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 tcExtendTyVarEnv tvs thing_inside
-  = tc_extend_tv_env [ATyVar tv (mkTyVarTy tv) | tv <- tvs] thing_inside
+  = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 
-tcExtendTyVarEnv2 :: [(TyVar,TcTyVar)] -> TcM r -> TcM r
-tcExtendTyVarEnv2 tv_pairs thing_inside
-  = tc_extend_tv_env [ATyVar tv1 (mkTyVarTy tv2) | (tv1,tv2) <- tv_pairs] thing_inside
-
-tcExtendTyVarEnv3 :: [(TyVar,TcType)] -> TcM r -> TcM r
-tcExtendTyVarEnv3 ty_pairs thing_inside
-  = tc_extend_tv_env [ATyVar tv1 ty2 | (tv1,ty2) <- ty_pairs] thing_inside
-
-tc_extend_tv_env binds thing_inside
+tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
+tcExtendTyVarEnv2 binds thing_inside
   = getLclEnv     `thenM` \ env@(TcLclEnv {tcl_env = le, 
                                            tcl_tyvars = gtvs, 
                                            tcl_rdr = rdr_env}) ->
     let
-       names      = [getName tv | ATyVar tv _ <- binds]
-       rdr_env'   = extendLocalRdrEnv rdr_env names
-       le'        = extendNameEnvList le (names `zip` binds)
-       new_tv_set = tyVarsOfTypes [ty | ATyVar _ ty <- binds]
+       rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
+       new_tv_set = tyVarsOfTypes (map snd binds)
+       le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
     in
        -- It's important to add the in-scope tyvars to the global tyvar set
        -- as well.  Consider
@@ -351,17 +342,17 @@ find_thing ignore_it tidy_env (ATyVar tv ty)
     if ignore_it tv_ty then
        returnM (tidy_env, Nothing)
     else let
-       (tidy_env1, tv1)     = tidyOpenTyVar tidy_env  tv
-       (tidy_env2, tidy_ty) = tidyOpenType  tidy_env1 tv_ty
-       msg = sep [ppr tv1 <+> eq_stuff, nest 2 bound_at]
+       -- The name tv is scoped, so we don't need to tidy it
+       (tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
+       msg = sep [ppr tv <+> eq_stuff, nest 2 bound_at]
 
        eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty, 
-                  tv == tv' = empty
+                  tv == tyVarName tv' = empty
                 | otherwise = equals <+> ppr tidy_ty
                -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
        bound_at = ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
     in
-    returnM (tidy_env2, Just msg)
+    returnM (tidy_env1, Just msg)
 \end{code}
 
 
@@ -559,8 +550,8 @@ as well as explicit user written ones.
 \begin{code}
 data InstInfo
   = InstInfo {
-      iDFunId :: DFunId,               -- The dfun id
-      iBinds  :: InstBindings
+      iDFunId :: DFunId,               -- The dfun id.  Its forall'd type variables 
+      iBinds  :: InstBindings          -- scope over the stuff in InstBindings!
     }
 
 data InstBindings