From: simonpj <unknown>
Date: Thu, 18 Feb 1999 17:13:55 +0000 (+0000)
Subject: [project @ 1999-02-18 17:13:54 by simonpj]
X-Git-Tag: Approximately_9120_patches~6531
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=89300e499da98bf95bcc18d895ac4369e761819a;p=ghc-hetmet.git

[project @ 1999-02-18 17:13:54 by simonpj]
Allow completely unbound tyvars of non-type kind
---

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index ee2ead7..220bc06 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -27,7 +27,7 @@ module OccName (
 	mkSrcOccFS, mkSysOcc, mkSysOccFS, mkSrcVarOcc, mkKindOccFS,
 	mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
 	mkDictOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
- 	mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
+ 	mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
 	
 	isTvOcc, isDataOcc, isDataSymOcc, isSymOcc,
 
@@ -401,8 +401,9 @@ mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
 -- These derived variables have a prefix that no Haskell value could have
 mkWorkerOcc        = mk_simple_deriv varName  "$w"
 mkDefaultMethodOcc = mk_simple_deriv varName  "$dm"
-mkClassTyConOcc    = mk_simple_deriv tcName   ":T"	-- The : prefix makes sure it classifies
-mkClassDataConOcc  = mk_simple_deriv dataName ":D"	-- as a tycon/datacon
+mkDerivedTyConOcc  = mk_simple_deriv tcName   ":"	-- The : prefix makes sure it classifies
+mkClassTyConOcc    = mk_simple_deriv tcName   ":T"	-- as a tycon/datacon
+mkClassDataConOcc  = mk_simple_deriv dataName ":D"	--
 mkDictOcc	   = mk_simple_deriv varName  "$d"
 mkSpecOcc	   = mk_simple_deriv varName  "$s"
 mkForeignExportOcc = mk_simple_deriv varName  "$f"
diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 7d3a79d..651c76e 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -58,7 +58,8 @@ import Type		( Type(..), Kind, ThetaType, TyNote(..),
 			  fullSubstTy, substTopTy, 
 			  typeCon, openTypeKind, boxedTypeKind, boxedKind, superKind, superBoxity
 			)
-import TyCon		( tyConKind )
+import TyCon		( tyConKind, mkPrimTyCon )
+import PrimRep		( PrimRep(VoidRep) )
 import VarEnv
 import VarSet		( emptyVarSet )
 import Var		( TyVar, tyVarKind, tyVarName, isTyVar, isMutTyVar, mkTyVar )
@@ -67,8 +68,10 @@ import Var		( TyVar, tyVarKind, tyVarName, isTyVar, isMutTyVar, mkTyVar )
 import TcMonad
 import TysWiredIn	( voidTy )
 
-import Name		( NamedThing(..), setNameUnique, mkSysLocalName )
-import Unique		( Unique )
+import Name		( NamedThing(..), setNameUnique, mkSysLocalName,
+			  mkDerivedName, mkDerivedTyConOcc
+			)
+import Unique		( Unique, Uniquable(..) )
 import Util		( nOfThem )
 import Outputable
 \end{code}
@@ -336,15 +339,14 @@ zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
 		tcPutTyVar tv voidTy	-- Just to avoid creating a new tycon in
 					-- this vastly common case
 	  else
-		tcPutTyVar tv (TyConApp (mk_void_tycon tv) [])
-
-    mk_void_tycon tv	-- Make a new TyCon with the same kind as the 
-			-- type variable tv.  Same name too, apart from
-			-- making it start with a capital letter (sigh)
-			-- I can't quite bring myself to write the Name-fiddling
-			-- code yet.  ToDo.  SLPJ Nov 98
-	= pprPanic "zonkTcTypeToType: free type variable with non-* type:" (ppr tv)
+		tcPutTyVar tv (TyConApp (mk_void_tycon tv kind) [])
 
+    mk_void_tycon tv kind	-- Make a new TyCon with the same kind as the 
+				-- type variable tv.  Same name too, apart from
+				-- making it start with a colon (sigh)
+	= mkPrimTyCon tc_name kind 0 VoidRep
+	where
+	  tc_name = mkDerivedName mkDerivedTyConOcc (getName tv) (getUnique tv)
 
 -- zonkTcTyVarToTyVar is applied to the *binding* occurrence 
 -- of a type variable, at the *end* of type checking.