[project @ 2002-03-29 21:39:36 by sof]

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

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 09f9b51..f7a8472 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -41,13 +41,13 @@ import TcHsSyn      ( TcExpr, TcId, TypecheckedHsExpr,
 import TcMonad
 import TcEnv   ( TcIdSet, tcGetInstEnv, tcLookupId )
 import InstEnv ( InstLookupResult(..), lookupInstEnv )
-import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType,
+import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType, zapToType,
                  zonkTcThetaType, tcInstTyVar, tcInstType,
                )
 import TcType  ( Type, TcType, TcThetaType, TcPredType, TcTauType, TcTyVarSet,
                  SourceType(..), PredType, ThetaType, TyVarDetails(VanillaTv),
                  tcSplitForAllTys, tcSplitForAllTys, 
-                 tcSplitMethodTy, tcSplitRhoTy, tcFunArgTy,
+                 tcSplitMethodTy, tcSplitPhiTy, tcFunArgTy,
                  isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
                  tcIsTyVarTy, mkPredTy, mkTyVarTy, mkTyVarTys,
                  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
@@ -399,7 +399,7 @@ newMethodAtLoc inst_loc real_id tys
        (tyvars,rho)  = tcSplitForAllTys (idType real_id)
        rho_ty        = ASSERT( equalLength tyvars tys )
                        substTy (mkTopTyVarSubst tyvars tys) rho
-       (theta, tau)  = tcSplitRhoTy rho_ty
+       (theta, tau)  = tcSplitPhiTy rho_ty
     in
     newMethodWith inst_loc real_id tys theta tau       `thenNF_Tc` \ meth_inst ->
     returnNF_Tc (meth_inst, instToId meth_inst)
@@ -415,16 +415,19 @@ newOverloadedLit :: InstOrigin
                 -> HsOverLit
                 -> TcType
                 -> NF_TcM (TcExpr, LIE)
-newOverloadedLit orig lit ty
-  | Just expr <- shortCutLit lit ty
+newOverloadedLit orig lit expected_ty
+  | Just expr <- shortCutLit lit expected_ty
   = returnNF_Tc (expr, emptyLIE)
 
   | otherwise
   = tcGetInstLoc orig          `thenNF_Tc` \ loc ->
     tcGetUnique                        `thenNF_Tc` \ new_uniq ->
+    zapToType expected_ty      `thenNF_Tc_` 
+       -- The expected type might be a 'hole' type variable, 
+       -- in which case we must zap it to an ordinary type variable
     let
-       lit_inst = LitInst lit_id lit ty loc
-       lit_id   = mkSysLocal FSLIT("lit") new_uniq ty
+       lit_inst = LitInst lit_id lit expected_ty loc
+       lit_id   = mkSysLocal FSLIT("lit") new_uniq expected_ty
     in
     returnNF_Tc (HsVar (instToId lit_inst), unitLIE lit_inst)
 
@@ -565,7 +568,7 @@ lookupInst dict@(Dict _ (ClassP clas tys) loc)
           mapNF_Tc mk_ty_arg tyvars    `thenNF_Tc` \ ty_args ->
           let
                dfun_rho   = substTy (mkTyVarSubst tyvars ty_args) rho
-               (theta, _) = tcSplitRhoTy dfun_rho
+               (theta, _) = tcSplitPhiTy dfun_rho
                ty_app     = mkHsTyApp (HsVar dfun_id) ty_args
           in
           if null theta then
@@ -635,7 +638,7 @@ lookupSimpleInst clas tys
        -> returnNF_Tc (Just (substTheta (mkSubst emptyInScopeSet tenv) theta))
         where
           (_, rho)  = tcSplitForAllTys (idType dfun)
-          (theta,_) = tcSplitRhoTy rho
+          (theta,_) = tcSplitPhiTy rho
 
       other  -> returnNF_Tc Nothing
 \end{code}