[project @ 2002-03-08 15:50:53 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcSimplify.lhs

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index ca9180f..4c7f69d 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -41,10 +41,10 @@ import Inst         ( lookupInst, LookupInstResult(..),
 import TcEnv           ( tcGetGlobalTyVars, tcGetInstEnv, tcLookupGlobalId )
 import InstEnv         ( lookupInstEnv, classInstEnv, InstLookupResult(..) )
 import TcMType         ( zonkTcTyVarsAndFV, tcInstTyVars, checkAmbiguity )
-import TcType          ( TcTyVar, TcTyVarSet, ThetaType, 
+import TcType          ( TcTyVar, TcTyVarSet, ThetaType, TyVarDetails(VanillaTv),
                          mkClassPred, isOverloadedTy, mkTyConApp,
                          mkTyVarTy, tcGetTyVar, isTyVarClassPred, mkTyVarTys,
-                         tyVarsOfPred, isIPPred, inheritablePred, predHasFDs )
+                         tyVarsOfPred, isIPPred, isInheritablePred, predHasFDs )
 import Id              ( idType, mkUserLocal )
 import Var             ( TyVar )
 import Name            ( getOccName, getSrcLoc )
@@ -52,7 +52,7 @@ import NameSet                ( NameSet, mkNameSet, elemNameSet )
 import Class           ( classBigSig )
 import FunDeps         ( oclose, grow, improve, pprEquationDoc )
 import PrelInfo                ( isNumericClass, isCreturnableClass, isCcallishClass, 
-                         splitIdName, fstIdName, sndIdName )
+                         splitName, fstName, sndName )
 
 import Subst           ( mkTopTyVarSubst, substTheta, substTy )
 import TysWiredIn      ( unitTy, pairTyCon )
@@ -635,7 +635,7 @@ The net effect of [NO TYVARS]
 isFreeWhenInferring :: TyVarSet -> Inst        -> Bool
 isFreeWhenInferring qtvs inst
   =  isFreeWrtTyVars qtvs inst                 -- Constrains no quantified vars
-  && all inheritablePred (predsOfInst inst)    -- And no implicit parameter involved
+  && all isInheritablePred (predsOfInst inst)  -- And no implicit parameter involved
                                                -- (see "Notes on implicit parameters")
 
 isFreeWhenChecking :: TyVarSet -- Quantified tyvars
@@ -670,9 +670,14 @@ tcSimplifyCheck
 
 -- tcSimplifyCheck is used when checking expression type signatures,
 -- class decls, instance decls etc.
--- Note that we psss isFree (not isFreeAndInheritable) to tcSimplCheck
+--
+-- NB: we psss isFree (not isFreeAndInheritable) to tcSimplCheck
 -- It's important that we can float out non-inheritable predicates
 -- Example:            (?x :: Int) is ok!
+--
+-- NB: tcSimplifyCheck does not consult the
+--     global type variables in the environment; so you don't
+--     need to worry about setting them before calling tcSimplifyCheck
 tcSimplifyCheck doc qtvs givens wanted_lie
   = tcSimplCheck doc get_qtvs
                 givens wanted_lie      `thenTc` \ (qtvs', frees, binds) ->
@@ -1192,8 +1197,8 @@ split n split_id avail wanted
                    returnNF_Tc (andMonoBindList binds', concat rhss')
 
          do_one rhs = tcGetUnique                      `thenNF_Tc` \ uniq -> 
-                      tcLookupGlobalId fstIdName       `thenNF_Tc` \ fst_id -> 
-                      tcLookupGlobalId sndIdName       `thenNF_Tc` \ snd_id -> 
+                      tcLookupGlobalId fstName         `thenNF_Tc` \ fst_id ->
+                      tcLookupGlobalId sndName         `thenNF_Tc` \ snd_id ->
                       let 
                          x = mkUserLocal occ uniq pair_ty loc
                       in
@@ -1310,8 +1315,8 @@ tcImprove avails
        returnTc False
   where
     unify ((qtvs, t1, t2), doc)
-        = tcAddErrCtxt doc                     $
-          tcInstTyVars (varSetElems qtvs)      `thenNF_Tc` \ (_, _, tenv) ->
+        = tcAddErrCtxt doc                             $
+          tcInstTyVars VanillaTv (varSetElems qtvs)    `thenNF_Tc` \ (_, _, tenv) ->
           unifyTauTy (substTy tenv t1) (substTy tenv t2)
 \end{code}
 
@@ -1416,7 +1421,7 @@ isAvailable avails wanted = lookupFM avails wanted
 addLinearAvailable :: Avails -> Avail -> Inst -> NF_TcM (Avails, [Inst])
 addLinearAvailable avails avail wanted
   | need_split avail
-  = tcLookupGlobalId splitIdName               `thenNF_Tc` \ split_id ->
+  = tcLookupGlobalId splitName                 `thenNF_Tc` \ split_id ->
     newMethodAtLoc (instLoc wanted) split_id 
                   [linearInstType wanted]      `thenNF_Tc` \ (split_inst,_) ->
     returnNF_Tc (addToFM avails wanted (Linear 2 split_inst avail), [split_inst])
@@ -1729,7 +1734,7 @@ tcSimplifyDeriv :: [TyVar]
                -> TcM ThetaType        -- Needed
 
 tcSimplifyDeriv tyvars theta
-  = tcInstTyVars tyvars                                        `thenNF_Tc` \ (tvs, _, tenv) ->
+  = tcInstTyVars VanillaTv tyvars                      `thenNF_Tc` \ (tvs, _, tenv) ->
        -- The main loop may do unification, and that may crash if 
        -- it doesn't see a TcTyVar, so we have to instantiate. Sigh
        -- ToDo: what if two of them do get unified?