Commit ad6bc60d authored by simonpj's avatar simonpj
Browse files

[project @ 2001-08-28 10:03:23 by simonpj]

Add pprEquation
parent 986b581d
...@@ -46,7 +46,7 @@ import TcType ( ThetaType, PredType, mkClassPred, isOverloadedTy, ...@@ -46,7 +46,7 @@ import TcType ( ThetaType, PredType, mkClassPred, isOverloadedTy,
import Id ( idType ) import Id ( idType )
import NameSet ( mkNameSet ) import NameSet ( mkNameSet )
import Class ( classBigSig ) import Class ( classBigSig )
import FunDeps ( oclose, grow, improve ) import FunDeps ( oclose, grow, improve, pprEquationDoc )
import PrelInfo ( isNumericClass, isCreturnableClass, isCcallishClass ) import PrelInfo ( isNumericClass, isCreturnableClass, isCcallishClass )
import Subst ( mkTopTyVarSubst, substTheta, substTy ) import Subst ( mkTopTyVarSubst, substTheta, substTy )
...@@ -1128,7 +1128,7 @@ tcImprove avails ...@@ -1128,7 +1128,7 @@ tcImprove avails
if null eqns then if null eqns then
returnTc True returnTc True
else else
traceTc (ptext SLIT("Improve:") <+> vcat (map ppr_eqn eqns)) `thenNF_Tc_` traceTc (ptext SLIT("Improve:") <+> vcat (map pprEquationDoc eqns)) `thenNF_Tc_`
mapTc_ unify eqns `thenTc_` mapTc_ unify eqns `thenTc_`
returnTc False returnTc False
where where
...@@ -1136,10 +1136,6 @@ tcImprove avails ...@@ -1136,10 +1136,6 @@ tcImprove avails
= tcAddErrCtxt doc $ = tcAddErrCtxt doc $
tcInstTyVars (varSetElems qtvs) `thenNF_Tc` \ (_, _, tenv) -> tcInstTyVars (varSetElems qtvs) `thenNF_Tc` \ (_, _, tenv) ->
unifyTauTy (substTy tenv t1) (substTy tenv t2) unifyTauTy (substTy tenv t1) (substTy tenv t2)
ppr_eqn ((qtvs, t1, t2), doc)
= vcat [ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs))
<+> ppr t1 <+> ptext SLIT(":=:") <+> ppr t2,
nest 2 doc]
\end{code} \end{code}
The main context-reduction function is @reduce@. Here's its game plan. The main context-reduction function is @reduce@. Here's its game plan.
......
...@@ -7,6 +7,7 @@ It's better to read it as: "if we know these, then we're going to know these" ...@@ -7,6 +7,7 @@ It's better to read it as: "if we know these, then we're going to know these"
\begin{code} \begin{code}
module FunDeps ( module FunDeps (
Equation, pprEquation, pprEquationDoc,
oclose, grow, improve, checkInstFDs, checkClsFD, pprFundeps oclose, grow, improve, checkInstFDs, checkClsFD, pprFundeps
) where ) where
...@@ -20,6 +21,7 @@ import TcType ( Type, ThetaType, SourceType(..), PredType, ...@@ -20,6 +21,7 @@ import TcType ( Type, ThetaType, SourceType(..), PredType,
predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred, predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred,
unifyTyListsX, unifyExtendTysX, tcEqType unifyTyListsX, unifyExtendTysX, tcEqType
) )
import PprType ( )
import VarSet import VarSet
import VarEnv import VarEnv
import Outputable import Outputable
...@@ -157,6 +159,10 @@ type Equation = (TyVarSet, Type, Type) -- These two types should be equal, for s ...@@ -157,6 +159,10 @@ type Equation = (TyVarSet, Type, Type) -- These two types should be equal, for s
-- --
pprEquationDoc (eqn, doc) = vcat [pprEquation eqn, nest 2 doc]
pprEquation (qtvs, t1, t2) = ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs))
<+> ppr t1 <+> ptext SLIT(":=:") <+> ppr t2
---------- ----------
improve :: InstEnv Id -- Gives instances for given class improve :: InstEnv Id -- Gives instances for given class
...@@ -287,7 +293,10 @@ checkClsFD qtvs fd clas_tvs tys1 tys2 ...@@ -287,7 +293,10 @@ checkClsFD qtvs fd clas_tvs tys1 tys2
-- unifyTyListsX will only bind variables in qtvs, so it's OK! -- unifyTyListsX will only bind variables in qtvs, so it's OK!
= case unifyTyListsX qtvs ls1 ls2 of = case unifyTyListsX qtvs ls1 ls2 of
Nothing -> [] Nothing -> []
Just unif -> [ (qtvs', substTy full_unif r1, substTy full_unif r2) Just unif -> -- pprTrace "checkFD" (vcat [ppr_fd fd,
-- ppr (varSetElems qtvs) <+> (ppr ls1 $$ ppr ls2),
-- ppr unif]) $
[ (qtvs', substTy full_unif r1, substTy full_unif r2)
| (r1,r2) <- rs1 `zip` rs2, | (r1,r2) <- rs1 `zip` rs2,
not (maybeToBool (unifyExtendTysX qtvs unif r1 r2))] not (maybeToBool (unifyExtendTysX qtvs unif r1 r2))]
-- Don't include any equations that already hold -- Don't include any equations that already hold
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment