[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 (file)
--- 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 (file)
--- 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.