X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=db151f1ce4a98fa879aaecfe6a383171d02d1f8a;hb=02c48cf14cd8c7771dfb41089412f35e1eaeedd5;hp=3eb14198457ffe3a2c0cfa7d6c402d6e5de67463;hpb=f4510d27c5883fe7e8570f4dd49d45a8b0122f2c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 3eb1419..db151f1 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -59,7 +59,7 @@ module TcType (
 
   ---------------------------------
   -- Misc type manipulators
-  deNoteType, classesOfTheta,
+  deNoteType,
   tyClsNamesOfType, tyClsNamesOfDFunHead, 
   getDFunTyKey,
 
@@ -70,7 +70,7 @@ module TcType (
   mkDictTy, tcSplitPredTy_maybe, 
   isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique, 
   mkClassPred, isInheritablePred, isIPPred, 
-  dataConsStupidTheta, isRefineableTy,
+  dataConsStupidTheta, isRefineableTy, isRefineablePred,
 
   ---------------------------------
   -- Foreign import and export
@@ -540,7 +540,7 @@ mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
 
 mkPhiTy :: [PredType] -> Type -> Type
-mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
+mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
 \end{code}
 
 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
@@ -569,15 +569,20 @@ isBoxyTy ty = any isBoxyTyVar (varSetElems (tcTyVarsOfType ty))
 
 isRigidTy :: TcType -> Bool
 -- A type is rigid if it has no meta type variables in it
-isRigidTy ty = all isSkolemTyVar (varSetElems (tcTyVarsOfType ty))
+isRigidTy ty = all isImmutableTyVar (varSetElems (tcTyVarsOfType ty))
 
 isRefineableTy :: TcType -> Bool
 -- A type should have type refinements applied to it if it has
 -- free type variables, and they are all rigid
-isRefineableTy ty = not (null tc_tvs) && all isSkolemTyVar tc_tvs
+isRefineableTy ty = not (null tc_tvs) && all isImmutableTyVar tc_tvs
 		    where
 		      tc_tvs = varSetElems (tcTyVarsOfType ty)
 
+isRefineablePred :: TcPredType -> Bool
+isRefineablePred pred = not (null tc_tvs) && all isImmutableTyVar tc_tvs
+		      where
+		        tc_tvs = varSetElems (tcTyVarsOfPred pred)
+
 ---------------
 getDFunTyKey :: Type -> OccName	-- Get some string from a type, to be used to 
 				-- construct a dictionary function name
@@ -845,7 +850,8 @@ isInheritablePred :: PredType -> Bool
 -- but it doesn't need to be quantified over the Num a dictionary
 -- which can be free in g's rhs, and shared by both calls to g
 isInheritablePred (ClassP _ _) = True
-isInheritablePred other	     = False
+isInheritablePred (EqPred _ _) = True
+isInheritablePred other	       = False
 \end{code}
 
 --------------------- Equality predicates ---------------------------------
@@ -1038,10 +1044,6 @@ tyClsNamesOfDFunHead :: Type -> NameSet
 tyClsNamesOfDFunHead dfun_ty 
   = case tcSplitSigmaTy dfun_ty of
 	(tvs,_,head_ty) -> tyClsNamesOfType head_ty
-
-classesOfTheta :: ThetaType -> [Class]
--- Looks just for ClassP things; maybe it should check
-classesOfTheta preds = [ c | ClassP c _ <- preds ]
 \end{code}