From: simonpj <unknown>
Date: Fri, 14 Jul 2000 13:38:55 +0000 (+0000)
Subject: [project @ 2000-07-14 13:38:55 by simonpj]
X-Git-Tag: Approximately_9120_patches~4007
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=19c346326289b3c935ab973bd969cd33702cb832;p=ghc-hetmet.git

[project @ 2000-07-14 13:38:55 by simonpj]
Fix typeKind
---

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}