From 19c346326289b3c935ab973bd969cd33702cb832 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 14 Jul 2000 13:38:55 +0000
Subject: [PATCH] [project @ 2000-07-14 13:38:55 by simonpj] Fix typeKind

---
 ghc/compiler/types/Type.lhs |   11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 109c8e4..f20ef3d 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -782,13 +782,16 @@ typeKind (AppTy fun arg)	= funResultTy (typeKind fun)
 
 typeKind (FunTy arg res)	= fix_up (typeKind res)
 				where
-				  fix_up kind = case splitTyConApp_maybe kind of
-						  Just (tycon, [_]) | tycon == typeCon	-> boxedTypeKind
-						  other					-> kind
+				  fix_up (TyConApp tycon _) |  tycon == typeCon
+							    || tycon == openKindCon = boxedTypeKind
+				  fix_up (NoteTy _ kind) = fix_up kind
+				  fix_up kind	         = kind
 		-- The basic story is 
 		-- 	typeKind (FunTy arg res) = typeKind res
 		-- But a function is boxed regardless of its result type
-		-- Hencd the strange fix-up
+		-- Hence the strange fix-up.
+		-- Note that 'res', being the result of a FunTy, can't have 
+		-- a strange kind like (*->*).
 
 typeKind (ForAllTy tv ty)	= typeKind ty
 \end{code}
-- 
1.7.10.4