[project @ 2001-04-14 07:36:58 by lewie]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcType.lhs

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 3d260dd..2cee03e 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -13,7 +13,7 @@ module TcType (
   newTyVarTys,         -- Int -> Kind -> NF_TcM [TcType]
 
   -----------------------------------------
-  TcType, TcTauType, TcThetaType, TcRhoType, TcClassContext,
+  TcType, TcTauType, TcThetaType, TcRhoType,
 
        -- Find the type to which a type variable is bound
   tcPutTyVar,          -- :: TcTyVar -> TcType -> NF_TcM TcType
@@ -33,6 +33,7 @@ module TcType (
   --------------------------------
   zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkTcSigTyVars,
   zonkTcType, zonkTcTypes, zonkTcClassConstraints, zonkTcThetaType,
+  zonkTcPredType,
 
   zonkTcTypeToType, zonkTcTyVarToTyVar, zonkKindEnv
 
@@ -187,7 +188,8 @@ fresh type variables, splits off the dictionary part, and returns the results.
 tcInstType :: TcType -> NF_TcM ([TcTyVar], TcThetaType, TcType)
 tcInstType ty
   = case splitForAllTys ty of
-       ([],     _)   -> returnNF_Tc ([], [], ty)        -- Nothing to do
+       ([],     rho) -> tcSplitRhoTy rho                       `thenNF_Tc` \ (theta, tau) ->
+                        returnNF_Tc ([], theta, tau)
        (tyvars, rho) -> tcInstTyVars tyvars                    `thenNF_Tc` \ (tyvars', _, tenv)  ->
                         tcSplitRhoTy (substTy tenv rho)        `thenNF_Tc` \ (theta, tau) ->
                         returnNF_Tc (tyvars', theta, tau)
@@ -313,9 +315,9 @@ zonkTcThetaType :: TcThetaType -> NF_TcM TcThetaType
 zonkTcThetaType theta = mapNF_Tc zonkTcPredType theta
 
 zonkTcPredType :: TcPredType -> NF_TcM TcPredType
-zonkTcPredType (Class c ts) =
+zonkTcPredType (ClassP c ts) =
     zonkTcTypes ts     `thenNF_Tc` \ new_ts ->
-    returnNF_Tc (Class c new_ts)
+    returnNF_Tc (ClassP c new_ts)
 zonkTcPredType (IParam n t) =
     zonkTcType t       `thenNF_Tc` \ new_t ->
     returnNF_Tc (IParam n new_t)
@@ -346,7 +348,7 @@ zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
        --      Void            if it has kind Lifted
        --      :Void           otherwise
     zonk_unbound_tyvar tv
-       | kind == liftedTypeKind
+       | kind == liftedTypeKind || kind == openTypeKind
        = tcPutTyVar tv voidTy  -- Just to avoid creating a new tycon in
                                -- this vastly common case
        | otherwise
@@ -446,8 +448,8 @@ zonkType unbound_var_fn ty
                             go ty                      `thenNF_Tc` \ ty' ->
                             returnNF_Tc (ForAllTy tyvar' ty')
 
-    go_pred (Class c tys) = mapNF_Tc go tys    `thenNF_Tc` \ tys' ->
-                           returnNF_Tc (Class c tys')
+    go_pred (ClassP c tys) = mapNF_Tc go tys   `thenNF_Tc` \ tys' ->
+                            returnNF_Tc (ClassP c tys')
     go_pred (IParam n ty) = go ty              `thenNF_Tc` \ ty' ->
                            returnNF_Tc (IParam n ty')