X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=fe5ea396924950e3914ff2bc65beffc619e42ebd;hb=ebec49fed627b7dd17e297ddc79a9c677a2ce538;hp=b1862b70a385a589cb7f59af67df6492a773b481;hpb=6084fb5517da34f65034370a3695e2af3b85ce2b;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index b1862b7..fe5ea39 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -41,7 +41,7 @@ module TcType (
   -- Splitters  
   -- These are important because they do not look through newtypes
   tcView,
-  tcSplitForAllTys, tcSplitPhiTy, 
+  tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
@@ -421,7 +421,7 @@ pprUserTypeCtxt SpecInstCtxt    = ptext (sLit "a SPECIALISE instance pragma")
 tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
 -- Tidy the type inside a GenSkol, preparatory to printing it
 tidySkolemTyVar env tv
-  = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
+  = ASSERT( isTcTyVar tv && (isSkolemTyVar tv || isSigTyVar tv ) )
     (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
   where
     (env1, info1) = case tcTyVarDetails tv of
@@ -508,7 +508,7 @@ isTyConableTyVar tv
 	SkolemTv {}	    -> False
 	
 isSkolemTyVar tv 
-  = ASSERT( isTcTyVar tv )
+  = ASSERT2( isTcTyVar tv, ppr tv )
     case tcTyVarDetails tv of
 	SkolemTv _         -> True
  	MetaTv _ _         -> False
@@ -660,16 +660,24 @@ tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
 tcIsForAllTy (ForAllTy tv _) = not (isCoVar tv)
 tcIsForAllTy _               = False
 
-tcSplitPhiTy :: Type -> (ThetaType, Type)
-tcSplitPhiTy ty = split ty ty []
- where
-  split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
+tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
+-- Split off the first predicate argument from a type
+tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
+tcSplitPredFunTy_maybe (ForAllTy tv ty)
+  | isCoVar tv = Just (coVarPred tv, ty)
+tcSplitPredFunTy_maybe (FunTy arg res)
+  | Just p <- tcSplitPredTy_maybe arg = Just (p, res)
+tcSplitPredFunTy_maybe _
+  = Nothing
 
-  split _       (ForAllTy tv ty) ts
-        | isCoVar tv = split ty ty (coVarPred tv : ts)
-  split _        (FunTy arg res) ts 
-	| Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
-  split orig_ty _               ts = (reverse ts, orig_ty)
+tcSplitPhiTy :: Type -> (ThetaType, Type)
+tcSplitPhiTy ty
+  = split ty []
+  where
+    split ty ts 
+      = case tcSplitPredFunTy_maybe ty of
+	  Just (pred, ty) -> split ty (pred:ts)
+	  Nothing         -> (reverse ts, ty)
 
 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
@@ -999,8 +1007,9 @@ is_tc uniq ty = case tcSplitTyConApp_maybe ty of
 --     hence no 'coreView'.  This could, however, be changed without breaking
 --     any code.
 isOpenSynTyConApp :: TcTauType -> Bool
-isOpenSynTyConApp (TyConApp tc _) = isOpenSynTyCon tc
-isOpenSynTyConApp _other          = False
+isOpenSynTyConApp (TyConApp tc tys) = isOpenSynTyCon tc && 
+                                      length tys == tyConArity tc 
+isOpenSynTyConApp _other            = False
 \end{code}