[project @ 2002-03-06 09:04:57 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 9b49a02..d0993ba 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -44,7 +44,7 @@ import TcMType                ( zonkTcTyVarsAndFV, tcInstTyVars, checkAmbiguity )
 import TcType          ( TcTyVar, TcTyVarSet, ThetaType, 
                          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) ->
@@ -1059,7 +1064,7 @@ data Avail
                        --      is turned into an LinRhss
        [TcExpr]        -- A supply of suitable RHSs
 
-pprAvails avails = vcat [ppr inst <+> equals <+> pprAvail avail
+pprAvails avails = vcat [sep [ppr inst, nest 2 (equals <+> pprAvail avail)]
                        | (inst,avail) <- fmToList avails ]
 
 instance Outputable Avail where
@@ -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
@@ -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])