X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=e1b4bd4d57aea188a131971bd7aafa56158b9a33;hb=940524aec90652b5ef81789c9a453c57c0e42cc9;hp=8de9f6c6782566cbfe32533df30848917fdd56a4;hpb=b03781ed8049e2037a5b573918d46dcdcd4baeb1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 8de9f6c..e1b4bd4 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -112,6 +112,7 @@ subFunTys error_herald n_pats res_ty thing_inside
   where
 	-- In 'loop', the parameter 'arg_tys' accumulates 
 	-- the arg types so far, in *reverse order*
+	-- INVARIANT:   res_ty :: *
     loop n args_so_far res_ty
 	| Just res_ty' <- tcView res_ty  = loop n args_so_far res_ty'
 
@@ -193,10 +194,12 @@ boxySplitTyConApp tc orig_ty
 	return (args ++ args_so_far)
 
     loop n_req args_so_far (AppTy fun arg)
+      | n_req > 0
       = loop (n_req - 1) (arg:args_so_far) fun
 
     loop n_req args_so_far (TyVarTy tv)
       | isTyConableTyVar tv
+      , res_kind `isSubKind` tyVarKind tv
       = do { cts <- readMetaTyVar tv
 	   ; case cts of
 	       Indirect ty -> loop n_req args_so_far ty
@@ -205,7 +208,7 @@ boxySplitTyConApp tc orig_ty
 	}
       where
 	mk_res_ty arg_tys' = mkTyConApp tc arg_tys'
-	arg_kinds = map tyVarKind (take n_req (tyConTyVars tc))
+	(arg_kinds, res_kind) = splitKindFunTysN n_req (tyConKind tc)
 
     loop _ _ _ = boxySplitFailure (mkTyConApp tc (mkTyVarTys (tyConTyVars tc))) orig_ty
 
@@ -218,7 +221,8 @@ boxySplitListTy exp_ty = do { [elt_ty] <- boxySplitTyConApp listTyCon exp_ty
 ----------------------
 boxySplitAppTy :: BoxyRhoType				-- Type to split: m a
 	       -> TcM (BoxySigmaType, BoxySigmaType)	-- Returns m, a
--- Assumes (m: * -> k), where k is the kind of the incoming type
+-- If the incoming type is a mutable type variable of kind k, then 
+-- boxySplitAppTy returns a new type variable (m: * -> k); note the *.
 -- If the incoming type is boxy, then so are the result types; and vice versa
 
 boxySplitAppTy orig_ty
@@ -522,7 +526,7 @@ boxyLub orig_ty1 orig_ty2
 
 	-- Look inside type synonyms, but only if the naive version fails
     go ty1 ty2 | Just ty1' <- tcView ty1 = go ty1' ty2
-	       | Just ty2' <- tcView ty1 = go ty1 ty2'
+	       | Just ty2' <- tcView ty2 = go ty1 ty2'
 
     -- For now, we don't look inside ForAlls, PredTys
     go ty1 ty2 = orig_ty1	-- Default