[project @ 2002-02-05 15:02:23 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index cdd2c7e..9f47b32 100644 (file)
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -25,16 +25,17 @@ import TcHsSyn              ( TcMonoBinds )
 
 import Inst            ( Inst, InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, 
                          instToId, newDicts, newMethod )
-import TcEnv           ( RecTcEnv, TyThingDetails(..), tcAddImportedIdInfo,
+import TcEnv           ( RecTcEnv, TyThingDetails(..), 
                          tcLookupClass, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars,
                          tcExtendLocalValEnv, tcExtendTyVarEnv
                        )
 import TcBinds         ( tcBindWithSigs, tcSpecSigs )
-import TcMonoType      ( tcHsType, tcHsTheta, checkSigTyVars, sigCtxt, mkTcSig )
+import TcMonoType      ( tcHsType, tcHsTheta, mkTcSig )
 import TcSimplify      ( tcSimplifyCheck, bindInstsOfLocalFuns )
+import TcUnify         ( checkSigTyVars, sigCtxt )
 import TcMType         ( tcInstSigTyVars, checkValidTheta, checkValidType, SourceTyCtxt(..), UserTypeCtxt(..) )
 import TcType          ( Type, TyVarDetails(..), TcType, TcThetaType, TcTyVar, 
-                         mkSigmaTy, mkTyVarTys, mkPredTys, mkClassPred, 
+                         mkTyVarTys, mkPredTys, mkClassPred, 
                          tcIsTyVarTy, tcSplitTyConApp_maybe, tcSplitSigmaTy
                        )
 import TcMonad
@@ -101,9 +102,8 @@ Death to "ExpandingDicts".
 
 \begin{code}
 
-tcClassDecl1 :: RecTcEnv -> RenamedTyClDecl -> TcM (Name, TyThingDetails)
-tcClassDecl1 rec_env
-            (ClassDecl {tcdCtxt = context, tcdName = class_name,
+tcClassDecl1 :: RenamedTyClDecl -> TcM (Name, TyThingDetails)
+tcClassDecl1 (ClassDecl {tcdCtxt = context, tcdName = class_name,
                         tcdTyVars = tyvar_names, tcdFDs = fundeps,
                         tcdSigs = class_sigs, tcdMeths = def_methods,
                         tcdSysNames = sys_names, tcdLoc = src_loc})
@@ -124,10 +124,10 @@ tcClassDecl1 rec_env
        -- only the type variable of the class decl.
        -- Context is already kind-checked
     ASSERT( equalLength context sc_sel_names )
-    tcHsTheta context                                          `thenTc` \ sc_theta ->
+    tcHsTheta context                                  `thenTc` \ sc_theta ->
 
        -- CHECK THE CLASS SIGNATURES,
-    mapTc (tcClassSig rec_env clas tyvars mb_dm_env) op_sigs   `thenTc` \ sig_stuff ->
+    mapTc (tcClassSig clas tyvars mb_dm_env) op_sigs   `thenTc` \ sig_stuff ->
 
        -- MAKE THE CLASS DETAILS
     let
@@ -199,8 +199,7 @@ checkDefaultBinds clas ops (Just mbs)
 
 
 \begin{code}
-tcClassSig :: RecTcEnv                 -- Knot tying only!
-          -> Class                     -- ...ditto...
+tcClassSig :: Class                    -- ...ditto...
           -> [TyVar]                   -- The class type variable, used for error check only
           -> Maybe (NameEnv Bool)      -- Info about default methods; 
                                        --      Nothing => imported class defn with no method binds
@@ -213,7 +212,7 @@ tcClassSig :: RecTcEnv                      -- Knot tying only!
 -- so we distinguish them in checkDefaultBinds, and pass this knowledge in the
 -- Class.DefMeth data structure. 
 
-tcClassSig unf_env clas clas_tyvars maybe_dm_env
+tcClassSig clas clas_tyvars maybe_dm_env
           (ClassOpSig op_name sig_dm op_ty src_loc)
   = tcAddSrcLoc src_loc $
 
@@ -495,7 +494,6 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta
     let
        meth_id    = instToId meth
        meth_name  = idName meth_id
-       sig_msg    = ptext SLIT("When checking the expected type for class method") <+> ppr sel_id
        meth_prags = find_prags (idName sel_id) meth_name prags
     in
     mkTcSig meth_id loc                        `thenNF_Tc` \ sig_info -> 
@@ -532,7 +530,9 @@ tcMethodBind clas origin inst_tyvars inst_tys inst_theta
      -- We do this for each method independently to localise error messages
      -- ...and this is why the call to tcExtendGlobalTyVars must be here
      --    rather than in the caller
-     tcAddErrCtxtM (sigCtxt sig_msg inst_tyvars inst_theta (idType meth_id))   $
+     tcAddErrCtxt (ptext SLIT("When checking the type of class method") 
+                  <+> quotes (ppr sel_id))                                     $
+     tcAddErrCtxtM (sigCtxt inst_tyvars inst_theta (idType meth_id))   $
      checkSigTyVars inst_tyvars emptyVarSet                                    `thenTc_` 
 
      returnTc (binds `AndMonoBinds` prag_binds1 `AndMonoBinds` prag_binds2,