X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyFuns.lhs;h=4c5be1c8993ce7d226b2bcc797d1a56eb7ad36a9;hb=af97da871e57bfd256f21e3c8bff5ef34b83f7ce;hp=e3e28ab57ae16380064a778a11362e2a302340d0;hpb=3bbdfc759bf1f466313afab0c0c50547ccde8e24;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs
index e3e28ab..4c5be1c 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
@@ -36,6 +35,7 @@ import Bag
 import Outputable
 import SrcLoc	( Located(..) )
 import Maybes
+import FastString
 
 -- standard
 import Data.List
@@ -230,10 +230,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 +306,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 +319,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
@@ -1181,7 +1152,7 @@ genericNormaliseInsts isWanted fun insts
 			      --        else
 			      -- 	  dict' = dict  `cast` co
 		          expr      = HsVar $ instToId source_dict
-		          cast_expr = HsWrap (WpCo st_co) expr
+		          cast_expr = HsWrap (WpCast st_co) expr
 			  rhs       = L (instLocSpan loc) cast_expr
 			  binds     = instToDictBind target_dict rhs
 		      -- return the new inst
@@ -1240,9 +1211,9 @@ misMatchMsg :: TidyEnv -> (TcType, TcType) -> (TidyEnv, SDoc)
 misMatchMsg env0 (ty_act, ty_exp)
   = let (env1, pp_exp, extra_exp) = ppr_ty env0 ty_exp
 	(env2, pp_act, extra_act) = ppr_ty env1 ty_act
-        msg = sep [sep [ptext SLIT("Couldn't match expected type") <+> pp_exp, 
+        msg = sep [sep [ptext (sLit "Couldn't match expected type") <+> pp_exp, 
 			nest 7 $
-                              ptext SLIT("against inferred type") <+> pp_act],
+                              ptext (sLit "against inferred type") <+> pp_act],
 		   nest 2 (extra_exp $$ extra_act)]
     in
     (env2, msg)