X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyFuns.lhs;h=36ff1bbb3efbbab62521658350fae87bb3e32583;hb=9e5f0a0f6848dd8234a83d8ff514365aa4717eea;hp=e3e28ab57ae16380064a778a11362e2a302340d0;hpb=3bbdfc759bf1f466313afab0c0c50547ccde8e24;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs index e3e28ab..36ff1bb 100644 --- a/compiler/typecheck/TcTyFuns.lhs +++ b/compiler/typecheck/TcTyFuns.lhs @@ -7,7 +7,6 @@ module TcTyFuns ( normaliseGivenEqs, normaliseGivenDicts, normaliseWantedEqs, normaliseWantedDicts, - solveWantedEqs, -- errors misMatchMsg, failWithMisMatch @@ -230,10 +229,6 @@ tcGenericNormaliseFamInst fun (ForAllTy tyvar ty1) = do { (coi,nty1) <- tcGenericNormaliseFamInst fun ty1 ; return (mkForAllTyCoI tyvar coi, mkForAllTy tyvar nty1) } -tcGenericNormaliseFamInst fun (NoteTy note ty1) - = do { (coi,nty1) <- tcGenericNormaliseFamInst fun ty1 - ; return (coi, NoteTy note nty1) - } tcGenericNormaliseFamInst fun ty@(TyVarTy tv) | isTcTyVar tv = do { traceTc (text "tcGenericNormaliseFamInst" <+> ppr ty) @@ -310,38 +305,12 @@ normaliseGivenEqs givens \end{code} \begin{code} -normaliseWantedEqs :: [Inst] -> TcM [Inst] -normaliseWantedEqs insts - = do { traceTc (text "normaliseWantedEqs <-" <+> ppr insts) - ; result <- liftM fst $ rewriteToFixedPoint Nothing - [ ("(ZONK)", dontRerun $ zonkInsts) - , ("(TRIVIAL)", dontRerun $ trivialRule) - , ("(DECOMP)", decompRule) - , ("(TOP)", topRule) - , ("(UNIFY)", unifyMetaRule) -- incl. occurs check - , ("(SUBST)", substRule) -- incl. occurs check - ] insts - ; traceTc (text "normaliseWantedEqs ->" <+> ppr result) - ; return result - } -\end{code} - - -%************************************************************************ -%* * -\section{Solving of wanted constraints with respect to a given set} -%* * -%************************************************************************ - -The set of given equalities must have been normalised already. - -\begin{code} -solveWantedEqs :: [Inst] -- givens - -> [Inst] -- wanteds - -> TcM [Inst] -- irreducible wanteds -solveWantedEqs givens wanteds - = do { traceTc $ text "solveWantedEqs <-" <+> ppr wanteds <+> text "with" <+> - ppr givens +normaliseWantedEqs :: [Inst] -- givens + -> [Inst] -- wanteds + -> TcM [Inst] -- irreducible wanteds +normaliseWantedEqs givens wanteds + = do { traceTc $ text "normaliseWantedEqs <-" <+> ppr wanteds + <+> text "with" <+> ppr givens ; result <- liftM fst $ rewriteToFixedPoint Nothing [ ("(ZONK)", dontRerun $ zonkInsts) , ("(TRIVIAL)", dontRerun $ trivialRule) @@ -349,8 +318,9 @@ solveWantedEqs givens wanteds , ("(TOP)", topRule) , ("(GIVEN)", substGivens givens) -- incl. occurs check , ("(UNIFY)", unifyMetaRule) -- incl. occurs check + , ("(SUBST)", substRule) -- incl. occurs check ] wanteds - ; traceTc (text "solveWantedEqs ->" <+> ppr result) + ; traceTc (text "normaliseWantedEqs ->" <+> ppr result) ; return result } where