X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=579c5da6a3ad901691cf96228145539b8b7eead7;hb=f87cc9cfccf83b21a66501f9654d3e6f1fa7adb4;hp=f894cd304f1e0bac556c732613af689dbf0e647d;hpb=b06d623b2e367a572de5daf06d6a0b12c2740471;p=ghc-hetmet.git

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index f894cd3..579c5da 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -6,7 +6,6 @@
 Type - public interface
 
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
 -- 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
@@ -31,7 +30,7 @@ module Type (
 
 	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, 
 	splitFunTys, splitFunTysN,
-	funResultTy, funArgTy, zipFunTys,
+	funResultTy, funArgTy, zipFunTys, typeArity,
 
 	mkTyConApp, mkTyConTy, 
 	tyConAppTyCon, tyConAppArgs, 
@@ -53,7 +52,7 @@ module Type (
         funTyCon,
 
         -- ** Predicates on types
-        isTyVarTy, isFunTy,
+        isTyVarTy, isFunTy, isDictTy,
 
 	-- (Lifting and boxity)
 	isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
@@ -142,6 +141,7 @@ import VarSet
 import Name
 import Class
 import TyCon
+import BasicTypes	( Arity )
 
 -- others
 import StaticFlags
@@ -151,6 +151,8 @@ import FastString
 
 import Data.List
 import Data.Maybe	( isJust )
+
+infixr 3 `mkFunTy`	-- Associates to the right
 \end{code}
 
 \begin{code}
@@ -496,6 +498,14 @@ funArgTy :: Type -> Type
 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
 funArgTy (FunTy arg _res)  = arg
 funArgTy ty                = pprPanic "funArgTy" (ppr ty)
+
+typeArity :: Type -> Arity
+-- How many value arrows are visible in the type?
+-- We look through foralls, but not through newtypes, dictionaries etc
+typeArity ty | Just ty' <- coreView ty = typeArity ty'
+typeArity (FunTy _ ty)    = 1 + typeArity ty
+typeArity (ForAllTy _ ty) = typeArity ty
+typeArity _               = 0
 \end{code}
 
 ---------------------------------------------------------------------
@@ -820,6 +830,11 @@ pprSourceTyCon tycon
   = ppr $ fam_tc `TyConApp` tys	       -- can't be FunTyCon
   | otherwise
   = ppr tycon
+
+isDictTy :: Type -> Bool
+isDictTy ty = case splitTyConApp_maybe ty of
+                Just (tc, _) -> isClassTyCon tc
+		Nothing      -> False
 \end{code}
 
 
@@ -1330,7 +1345,7 @@ then (substTy subst ty) does nothing.
 For example, consider:
 	(/\a. /\b:(a~Int). ...b..) Int
 We substitute Int for 'a'.  The Unique of 'b' does not change, but
-nevertheless we add 'b' to the TvSubstEnv, because b's type does change
+nevertheless we add 'b' to the TvSubstEnv, because b's kind does change
 
 This invariant has several crucial consequences: