From bcbb5b1e74623fe8d97ae711854c7925ed4ec0b4 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Tue, 24 Apr 2007 12:43:34 +0000 Subject: [PATCH] Fix bug in boxySplitTyConApp Merge to STABLE branch This bug was discovered by Nicolas Frisby. It's an egregious missing guard in boxySplitTyConApp. Test is tcfail180 --- compiler/typecheck/TcUnify.lhs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 8de9f6c..dac7803 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 -- 1.7.10.4