[project @ 2001-04-14 22:24:24 by qrczak]

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

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 103af50..86084ab 100644 (file)
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -44,8 +44,8 @@ import TyCon          ( tyConTyVars, tyConDataCons,
                          tyConTheta, maybeTyConSingleCon, isDataTyCon,
                          isEnumerationTyCon, TyCon
                        )
-import Type            ( TauType, PredType(..), mkTyVarTys, mkTyConApp, 
-                         isUnLiftedType )
+import Type            ( TauType, ThetaType, PredType, mkTyVarTys, mkTyConApp, 
+                         isUnLiftedType, mkClassPred )
 import Var             ( TyVar )
 import PrelNames
 import Util            ( zipWithEqual, sortLt )
@@ -143,9 +143,7 @@ type DerivEqn = (Name, Class, TyCon, [TyVar], DerivRhs)
                -- The Name is the name for the DFun we'll build
                -- The tyvars bind all the variables in the RHS
 
-type DerivRhs = [(Class, [TauType])]   -- Same as a ThetaType!
-               --[PredType]   -- ... | Class Class [Type==TauType]
-
+type DerivRhs  = ThetaType
 type DerivSoln = DerivRhs
 \end{code}
 
@@ -316,7 +314,7 @@ makeDerivEqns tycl_decls
            offensive_class = clas_key `elem` needsDataDeclCtxtClassKeys
     
            mk_constraints data_con
-              = [ (clas, [arg_ty])
+              = [ mkClassPred clas [arg_ty]
                 | arg_ty <- dataConArgTys data_con tyvar_tys,
                   not (isUnLiftedType arg_ty)  -- No constraints for unlifted types?
                 ]
@@ -407,7 +405,8 @@ solveDerivEqns inst_env_in orig_eqns
         in
            -- Simplify each RHS
        tcSetInstEnv inst_env (
-         listTc [ tcAddErrCtxt (derivCtxt tc) $
+         listTc [ tcAddSrcLoc (getSrcLoc tc)   $
+                  tcAddErrCtxt (derivCtxt tc)  $
                   tcSimplifyThetas deriv_rhs
                 | (_, _,tc,_,deriv_rhs) <- orig_eqns ]  
        )                                       `thenTc` \ next_solns ->
@@ -436,10 +435,9 @@ add_solns dflags inst_env_in eqns solns
        -- They'll appear later, when we do the top-level extendInstEnvs
 
       mk_deriv_dfun (dfun_name, clas, tycon, tyvars, _) theta
-        = mkDictFunId dfun_name clas tyvars [mkTyConApp tycon (mkTyVarTys tyvars)] 
-                     (map pair2PredType theta)
-
-      pair2PredType (clas, tautypes) = Class clas tautypes
+        = mkDictFunId dfun_name clas tyvars 
+                     [mkTyConApp tycon (mkTyVarTys tyvars)] 
+                     theta
 \end{code}
 
 %************************************************************************