[project @ 2003-06-16 15:32:16 by simonpj]

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

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index ce020f6..dc96759 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -36,7 +36,7 @@ module Inst (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}  TcExpr( tcExpr )
+import {-# SOURCE #-}  TcExpr( tcCheckSigma )
 
 import HsSyn   ( HsLit(..), HsOverLit(..), HsExpr(..) )
 import TcHsSyn ( TcExpr, TcId, TcIdSet, 
@@ -46,7 +46,7 @@ import TcHsSyn        ( TcExpr, TcId, TcIdSet,
 import TcRnMonad
 import TcEnv   ( tcGetInstEnv, tcLookupId, tcLookupTyCon, checkWellStaged, topIdLvl )
 import InstEnv ( InstLookupResult(..), lookupInstEnv )
-import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType, zapToType,
+import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType, 
                  zonkTcThetaType, tcInstTyVar, tcInstType, tcInstTyVars
                )
 import TcType  ( Type, TcType, TcThetaType, TcTyVarSet,
@@ -381,9 +381,6 @@ newOverloadedLit orig lit@(HsFractional r fr) expected_ty
 newLitInst orig lit expected_ty
   = getInstLoc orig            `thenM` \ loc ->
     newUnique                  `thenM` \ new_uniq ->
-    zapToType expected_ty      `thenM_` 
-       -- 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 expected_ty loc
        lit_id   = mkSysLocal FSLIT("lit") new_uniq expected_ty
@@ -662,9 +659,11 @@ tcSyntaxName orig ty std_nm user_nm
        -- C.f. newMethodAtLoc
        ([tv], _, tau)  = tcSplitSigmaTy (idType std_id)
        tau1            = substTyWith [tv] [ty] tau
+       -- Actually, the "tau-type" might be a sigma-type in the
+       -- case of locally-polymorphic methods.
     in
     addErrCtxtM (syntaxNameCtxt user_nm orig tau1)     $
-    tcExpr (HsVar user_nm) tau1                                `thenM` \ user_fn ->
+    tcCheckSigma (HsVar user_nm) tau1                  `thenM` \ user_fn ->
     returnM (user_fn, tau1)
 
 syntaxNameCtxt name orig ty tidy_env