[project @ 2001-08-14 06:35:56 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcType.lhs

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 8ebc1b4..a6abdcf 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -66,6 +66,7 @@ module TcType (
   Kind,        -- Stuff to do with kinds is insensitive to pre/post Tc
   unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds, 
   superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
+  isTypeKind,
 
   Type, SourceType(..), PredType, ThetaType, 
   mkForAllTy, mkForAllTys, 
@@ -96,7 +97,7 @@ import Type           (       -- Re-exports
                          tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
                          Kind, Type, TauType, SourceType(..), PredType, ThetaType, 
                          unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
-                         mkForAllTy, mkForAllTys, defaultKind,
+                         mkForAllTy, mkForAllTys, defaultKind, isTypeKind,
                          mkFunTy, mkFunTys, zipFunTys, 
                          mkTyConApp, mkAppTy, mkAppTys, mkSynTy, applyTy, applyTys,
                          mkTyVarTy, mkTyVarTys, mkTyConTy,
@@ -344,7 +345,7 @@ tcSplitPredTy_maybe (NoteTy _ ty)       = tcSplitPredTy_maybe ty
 tcSplitPredTy_maybe (UsageTy _ ty)         = tcSplitPredTy_maybe ty
 tcSplitPredTy_maybe (SourceTy p) | isPred p = Just p
 tcSplitPredTy_maybe other                  = Nothing
-
+       
 mkPredTy :: PredType -> Type
 mkPredTy pred = SourceTy pred
 
@@ -752,6 +753,14 @@ uTysX ty1 (TyVarTy tyvar2) k subst@(tmpls,_)
   | tyvar2 `elemVarSet` tmpls
   = uVarX tyvar2 ty1 k subst
 
+       -- Predicates
+uTysX (SourceTy (IParam n1 t1)) (SourceTy (IParam n2 t2)) k subst
+  | n1 == n2 = uTysX t1 t2 k subst
+uTysX (SourceTy (ClassP c1 tys1)) (SourceTy (ClassP c2 tys2)) k subst
+  | c1 == c2 = uTyListsX tys1 tys2 k subst
+uTysX (SourceTy (NType tc1 tys1)) (SourceTy (NType tc2 tys2)) k subst
+  | tc1 == tc2 = uTyListsX tys1 tys2 k subst
+
        -- Functions; just check the two parts
 uTysX (FunTy fun1 arg1) (FunTy fun2 arg2) k subst
   = uTysX fun1 fun2 (uTysX arg1 arg2 k) subst
@@ -891,6 +900,15 @@ match (TyVarTy v) ty tmpls k senv
     -- variable may not match the pattern (TyVarTy v') as one would
     -- expect, due to an intervening Note.  KSW 2000-06.
 
+       -- Predicates
+match (SourceTy (IParam n1 t1)) (SourceTy (IParam n2 t2)) tmpls k senv
+  | n1 == n2 = match t1 t2 tmpls k senv
+match (SourceTy (ClassP c1 tys1)) (SourceTy (ClassP c2 tys2)) tmpls k senv
+  | c1 == c2 = match_list_exactly tys1 tys2 tmpls k senv
+match (SourceTy (NType tc1 tys1)) (SourceTy (NType tc2 tys2)) tmpls k senv
+  | tc1 == tc2 = match_list_exactly tys1 tys2 tmpls k senv
+
+       -- Functions; just check the two parts
 match (FunTy arg1 res1) (FunTy arg2 res2) tmpls k senv
   = match arg1 arg2 tmpls (match res1 res2 tmpls k) senv
 
@@ -900,11 +918,11 @@ match (AppTy fun1 arg1) ty2 tmpls k senv
        Nothing          -> Nothing     -- Fail
 
 match (TyConApp tc1 tys1) (TyConApp tc2 tys2) tmpls k senv
-  | tc1 == tc2 = match_tc_app tys1 tys2 tmpls k senv
+  | tc1 == tc2 = match_list_exactly tys1 tys2 tmpls k senv
 
 -- Newtypes are opaque; other source types should not happen
 match (SourceTy (NType tc1 tys1)) (SourceTy (NType tc2 tys2)) tmpls k senv
-  | tc1 == tc2 = match_tc_app tys1 tys2 tmpls k senv
+  | tc1 == tc2 = match_list_exactly tys1 tys2 tmpls k senv
 
 match (UsageTy _ ty1) ty2 tmpls k senv = match ty1 ty2 tmpls k senv
 match ty1 (UsageTy _ ty2) tmpls k senv = match ty1 ty2 tmpls k senv
@@ -919,7 +937,7 @@ match ty1      (NoteTy n2 ty2) tmpls k senv = match ty1 ty2 tmpls k senv
 -- Catch-all fails
 match _ _ _ _ _ = Nothing
 
-match_tc_app tys1 tys2 tmpls k senv
+match_list_exactly tys1 tys2 tmpls k senv
   = match_list tys1 tys2 tmpls k' senv
   where
     k' (senv', tys2') | null tys2' = k senv'   -- Succeed