X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFamInstEnv.lhs;h=ba96a55e45fc695e95aec52c4f3b8646a6535cc2;hb=1ae354e107715a9e3fd4e2d67b61f868c090e4ae;hp=12df25d06ba4b140a6662b80ffb46f6eb115a031;hpb=3787d9878e4d62829a555f01b2a4c5866f24f303;p=ghc-hetmet.git

diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 12df25d..ba96a55 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -5,13 +5,6 @@
 FamInstEnv: Type checked family instance declarations
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module FamInstEnv (
 	FamInst(..), famInstTyCon, famInstTyVars, 
 	pprFamInst, pprFamInstHdr, pprFamInsts, 
@@ -31,8 +24,6 @@ module FamInstEnv (
 
 import InstEnv
 import Unify
-import TcGadt
-import TcType
 import Type
 import TypeRep
 import TyCon
@@ -40,12 +31,11 @@ import Coercion
 import VarSet
 import Var
 import Name
-import OccName
-import SrcLoc
 import UniqFM
 import Outputable
 import Maybes
 import Util
+import FastString
 
 import Maybe
 \end{code}
@@ -82,6 +72,7 @@ data FamInst
 famInstTyCon :: FamInst -> TyCon
 famInstTyCon = fi_tycon
 
+famInstTyVars :: FamInst -> TyVarSet
 famInstTyVars = fi_tvs
 \end{code}
 
@@ -96,16 +87,16 @@ instance Outputable FamInst where
 pprFamInst :: FamInst -> SDoc
 pprFamInst famInst
   = hang (pprFamInstHdr famInst)
-	2 (ptext SLIT("--") <+> pprNameLoc (getName famInst))
+	2 (ptext (sLit "--") <+> pprNameLoc (getName famInst))
 
 pprFamInstHdr :: FamInst -> SDoc
 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
   = pprTyConSort <+> pprHead
   where
-    pprHead = pprTypeApp fam (ppr fam) tys
-    pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
-		 | isNewTyCon  tycon = ptext SLIT("newtype instance")
-		 | isSynTyCon  tycon = ptext SLIT("type instance")
+    pprHead = pprTypeApp fam tys
+    pprTyConSort | isDataTyCon tycon = ptext (sLit "data instance")
+		 | isNewTyCon  tycon = ptext (sLit "newtype instance")
+		 | isSynTyCon  tycon = ptext (sLit "type instance")
 		 | otherwise	     = panic "FamInstEnv.pprFamInstHdr"
 
 pprFamInsts :: [FamInst] -> SDoc
@@ -322,16 +313,11 @@ lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
 		)
 		-- Unification will break badly if the variables overlap
 		-- They shouldn't because we allocate separate uniques for them
-        case tcUnifyTys bind_fn tpl_tys tys of
+        case tcUnifyTys instanceBindFun tpl_tys tys of
 	    Just subst -> let rep_tys = substTyVars subst (tyConTyVars tycon)
                           in
                           ((item, rep_tys), subst) : find rest
 	    Nothing    -> find rest
-
--- See explanation at @InstEnv.bind_fn@.
---
-bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
-	   | otherwise	 		 	   = BindMe
 \end{code}
 
 %************************************************************************
@@ -382,7 +368,7 @@ topNormaliseType env ty
 		-- to be sure that 
 	   add_co co rec_nts ty
 
-    go rec_nts ty = Nothing
+    go _ _ = Nothing
 
     add_co co rec_nts ty 
 	= case go rec_nts ty of
@@ -411,7 +397,7 @@ normaliseTcApp env tc tys
 
 		-- No unique matching family instance exists;
 		-- we do not do anything
-	other -> (tycon_coi, TyConApp tc ntys)
+	_ -> (tycon_coi, TyConApp tc ntys)
 ---------------
 normaliseType :: FamInstEnvs 		-- environment with family instances
 	      -> Type  			-- old type
@@ -422,26 +408,23 @@ normaliseType :: FamInstEnvs 		-- environment with family instances
 
 normaliseType env ty 
   | Just ty' <- coreView ty = normaliseType env ty' 
-normaliseType env ty@(TyConApp tc tys)
+normaliseType env (TyConApp tc tys)
   = normaliseTcApp env tc tys
-normaliseType env ty@(AppTy ty1 ty2)
+normaliseType env (AppTy ty1 ty2)
   = let (coi1,nty1) = normaliseType env ty1
         (coi2,nty2) = normaliseType env ty2
     in  (mkAppTyCoI nty1 coi1 nty2 coi2, AppTy nty1 nty2)
-normaliseType env ty@(FunTy ty1 ty2)
+normaliseType env (FunTy ty1 ty2)
   = let (coi1,nty1) = normaliseType env ty1
         (coi2,nty2) = normaliseType env ty2
     in  (mkFunTyCoI nty1 coi1 nty2 coi2, FunTy nty1 nty2)
-normaliseType env ty@(ForAllTy tyvar ty1)
+normaliseType env (ForAllTy tyvar ty1)
   = let (coi,nty1) = normaliseType env ty1
     in  (mkForAllTyCoI tyvar coi,ForAllTy tyvar nty1)
-normaliseType env ty@(NoteTy note ty1)
-  = let (coi,nty1) = normaliseType env ty1
-    in  (coi,NoteTy note nty1)
-normaliseType env ty@(TyVarTy _)
+normaliseType _   ty@(TyVarTy _)
   = (IdCo,ty)
 normaliseType env (PredTy predty)
-  = normalisePred env predty	
+  = normalisePred env predty
 
 ---------------
 normalisePred :: FamInstEnvs -> PredType -> (CoercionI,Type)