From 41d098e37b12157f7dca5e373e245b27d01baf3a Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 17 Mar 1999 08:26:30 +0000
Subject: [PATCH] [project @ 1999-03-17 08:26:30 by simonpj] Complete the hack
 that lets us give 'error' the type

	error :: forall a:?. String -> a

The kind '?' (also known as 'Type AnyBox') means that
error can be applied to unboxed types too.  unsafeCoerce is
similar.  But the 'real' type of error is:

	error :: forall bv. forall a:Type bv. String -> a

That is, it's really polymorphic in the boxity of a; that's
different to saying that the type bound to 'a' must have
kind '?'.

The fix was in TcType.inst_tyvar, where we look for the kind '?'
and generate a boxity variable instead.  Sigh.
---
 ghc/compiler/typecheck/TcType.lhs |   21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 651c76e..7305d51 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -181,7 +181,6 @@ tcInstTyVars tyvars
 inst_tyvar tyvar	-- Could use the name from the tyvar?
   = tcGetUnique 		`thenNF_Tc` \ uniq ->
     let
-	kind = tyVarKind tyvar
 	name = setNameUnique (tyVarName tyvar) uniq
 	-- Note that we don't change the print-name
 	-- This won't confuse the type checker but there's a chance
@@ -189,8 +188,26 @@ inst_tyvar tyvar	-- Could use the name from the tyvar?
 	-- in an error message.  -dppr-debug will show up the difference
 	-- Better watch out for this.  If worst comes to worst, just
 	-- use mkSysLocalName.
+
+	kind = tyVarKind tyvar
     in
-    tcNewMutTyVar name kind
+
+	-- Hack alert!  Certain system functions (like error) are quantified
+	-- over type variables with an 'open' kind (a :: ?).  When we instantiate
+	-- these tyvars we want to make a type variable whose kind is (Type bv)
+	-- where bv is a boxity variable.  This makes sure it's a type, but 
+	-- is open about its boxity.  We *don't* want to give the thing the
+	-- kind '?' (= Type AnyBox).  
+	--
+	-- This is all a hack to avoid giving error it's "proper" type:
+	--	 error :: forall bv. forall a::Type bv. String -> a
+
+    (if kind == openTypeKind then
+	newOpenTypeKind	
+     else
+	returnNF_Tc kind)	`thenNF_Tc` \ kind' ->
+
+    tcNewMutTyVar name kind'
 \end{code}
 
 @tcInstTcType@ instantiates the outer-level for-alls of a TcType with
-- 
1.7.10.4