X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=c9bf3f5d65a8af33e75053314fb75c4161d4a615;hb=924142621ebc30a3c16368e0df3466ee14185ddd;hp=8ff78fbccfa5f2c082fcb1b7d39b8d1c6e4a13ab;hpb=a40f2735958055f7ff94e5df73e710044aa63b2c;p=ghc-hetmet.git

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 8ff78fb..c9bf3f5 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -74,7 +74,8 @@ module Type (
 
 	-- * Type free variables
 	tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-	expandTypeSynonyms,
+	expandTypeSynonyms, 
+	typeSize,
 
 	-- * Type comparison
 	coreEqType, coreEqType2,
@@ -857,6 +858,28 @@ tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
 
 %************************************************************************
 %*									*
+                   Size									
+%*									*
+%************************************************************************
+
+\begin{code}
+typeSize :: Type -> Int
+typeSize (TyVarTy _)     = 1
+typeSize (AppTy t1 t2)   = typeSize t1 + typeSize t2
+typeSize (FunTy t1 t2)   = typeSize t1 + typeSize t2
+typeSize (PredTy p)      = predSize p
+typeSize (ForAllTy _ t)  = 1 + typeSize t
+typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
+
+predSize :: PredType -> Int
+predSize (IParam _ t)   = 1 + typeSize t
+predSize (ClassP _ ts)  = 1 + sum (map typeSize ts)
+predSize (EqPred t1 t2) = typeSize t1 + typeSize t2
+\end{code}
+
+
+%************************************************************************
+%*									*
 \subsection{Type families}
 %*									*
 %************************************************************************
@@ -926,9 +949,9 @@ isAlgType ty
 isClosedAlgType :: Type -> Bool
 isClosedAlgType ty
   = case splitTyConApp_maybe ty of
-      Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
-			    isAlgTyCon tc && not (isFamilyTyCon tc)
-      _other	         -> False
+      Just (tc, ty_args) | isAlgTyCon tc && not (isFamilyTyCon tc)
+             -> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True
+      _other -> False
 \end{code}
 
 \begin{code}