[project @ 2003-10-30 16:01:49 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcUnify.lhs
index cb4f73b..3d70bcb 100644 (file)
@@ -11,7 +11,7 @@ module TcUnify (
 
        -- Various unifications
   unifyTauTy, unifyTauTyList, unifyTauTyLists, 
-  unifyKind, unifyKinds, unifyTypeKind, unifyFunKind,
+  unifyKind, unifyKinds, unifyFunKind, 
 
   --------------------------------
   -- Holes
@@ -43,17 +43,15 @@ import TcType               ( TcKind, TcType, TcSigmaType, TcRhoType, TcTyVar, TcTauType,
                          isSkolemTyVar, isUserTyVar, 
                          tidyOpenType, tidyOpenTypes, tidyOpenTyVar, tidyOpenTyVars,
                          eqKind, openTypeKind, liftedTypeKind, isTypeKind, mkArrowKind,
-                         hasMoreBoxityInfo, allDistinctTyVars
-                       )
+                         hasMoreBoxityInfo, allDistinctTyVars, pprType )
 import Inst            ( newDicts, instToId, tcInstCall )
 import TcMType         ( getTcTyVar, putTcTyVar, tcInstType, newKindVar,
-                         newTyVarTy, newTyVarTys, newBoxityVar, 
+                         newTyVarTy, newTyVarTys, newOpenTypeKind,
                          zonkTcType, zonkTcTyVars, zonkTcTyVarsAndFV )
 import TcSimplify      ( tcSimplifyCheck )
 import TysWiredIn      ( listTyCon, parrTyCon, tupleTyCon )
 import TcEnv           ( tcGetGlobalTyVars, findGlobals )
 import TyCon           ( TyCon, tyConArity, isTupleTyCon, tupleTyConBoxity )
-import PprType         ( pprType )
 import Id              ( Id, mkSysLocal )
 import Var             ( Var, varName, tyVarKind )
 import VarSet          ( emptyVarSet, unitVarSet, unionVarSet, elemVarSet, varSetElems )
@@ -921,8 +919,8 @@ unifyTypeKind ty@(TyVarTy tyvar)
   = getTcTyVar tyvar   `thenM` \ maybe_ty ->
     case maybe_ty of
        Just ty' -> unifyTypeKind ty'
-       Nothing  -> newBoxityVar                                        `thenM` \ bx_var ->
-                   putTcTyVar tyvar (mkTyConApp typeCon [bx_var])      `thenM_`
+       Nothing  -> newOpenTypeKind             `thenM` \ kind -> 
+                   putTcTyVar tyvar kind       `thenM_`
                    returnM ()
        
 unifyTypeKind ty