%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[TcDeriv]{Deriving}
Handles @deriving@ clauses on @data@ declarations.
#include "HsVersions.h"
import HsSyn
-import DynFlags ( DynFlag(..) )
+import DynFlags
-import Generics ( mkTyConGenericBinds )
+import Generics
import TcRnMonad
-import TcMType ( checkValidInstance )
-import TcEnv ( newDFunName, pprInstInfoDetails,
- InstInfo(..), InstBindings(..), simpleInstInfoClsTy,
- tcLookupClass, tcLookupTyCon, tcLookupLocatedTyCon, tcExtendTyVarEnv
- )
+import TcEnv
import TcGenDeriv -- Deriv stuff
-import InstEnv ( Instance, OverlapFlag, mkLocalInstance, instanceHead, extendInstEnvList )
-import Inst ( getOverlapFlag )
-import TcHsType ( tcHsDeriv )
-import TcSimplify ( tcSimplifyDeriv )
-import TypeRep ( PredType )
-
-import RnBinds ( rnMethodBinds, rnTopBinds )
-import RnEnv ( bindLocalNames )
-import HscTypes ( FixityEnv )
-
-import Class ( className, classArity, classKey, classTyVars, classSCTheta, Class )
-import Type ( zipOpenTvSubst, substTheta, pprThetaArrow, pprClassPred, mkTyVarTy )
-import ErrUtils ( dumpIfSet_dyn )
-import MkId ( mkDictFunId )
-import DataCon ( isNullarySrcDataCon, isVanillaDataCon, dataConInstOrigArgTys )
-import Maybes ( catMaybes )
-import RdrName ( RdrName )
-import Name ( Name, getSrcLoc )
-import NameSet ( duDefs )
-import Type ( splitKindFunTys )
-import TyCon ( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
- tyConStupidTheta, isProductTyCon, isDataTyCon, isNewTyCon, newTyConRhs,
- isEnumerationTyCon, isRecursiveTyCon, TyCon
- )
-import TcType ( TcType, ThetaType, mkTyVarTys, mkTyConApp, tcTyConAppTyCon,
- isUnLiftedType, mkClassPred, tyVarsOfType, tyVarsOfTypes,
- isSubArgTypeKind, tcEqTypes, tcSplitAppTys, mkAppTys )
-import Var ( TyVar, tyVarKind, varName )
-import VarSet ( mkVarSet, disjointVarSet )
+import InstEnv
+import Inst
+import TcHsType
+import TcSimplify
+
+import RnBinds
+import RnEnv
+import HscTypes
+
+import Class
+import Type
+import ErrUtils
+import MkId
+import DataCon
+import Maybes
+import RdrName
+import Name
+import NameSet
+import TyCon
+import TcType
+import Var
+import VarSet
import PrelNames
-import SrcLoc ( SrcSpan, srcLocSpan, Located(..), unLoc )
-import Util ( zipWithEqual, sortLe, notNull )
-import ListSetOps ( removeDups, assocMaybe )
+import SrcLoc
+import Util
+import ListSetOps
import Outputable
import Bag
\end{code}
mk_eqn_help loc orig gla_exts new_or_data tycon deriv_tvs clas tys
------------------------------------------------------------------
- mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys
+ -- data/newtype T a = ... deriving( C t1 t2 )
+ -- leads to a call to mk_eqn_help with
+ -- tycon = T, deriv_tvs = ftv(t1,t2), clas = C, tys = [t1,t2]
+
+ mk_eqn_help loc orig gla_exts DataType tycon deriv_tvs clas tys
| Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
= bale_out (derivingThingErr clas tys tycon (tyConTyVars tycon) err)
| otherwise
do { let inst_tys = [mkTyConApp tc (mkTyVarTys tyvars)]
; theta <- addErrCtxt (derivInstCtxt1 clas inst_tys) $
tcSimplifyDeriv orig tc tyvars deriv_rhs
- ; addErrCtxt (derivInstCtxt2 theta clas inst_tys) $
- checkValidInstance tyvars theta clas inst_tys
- ; return (sortLe (<=) theta) } -- Canonicalise before returning the soluction
+ -- Claim: the result instance declaration is guaranteed valid
+ -- Hence no need to call:
+ -- checkValidInstance tyvars theta clas inst_tys
+ ; return (sortLe (<=) theta) } -- Canonicalise before returning the solution
where
-- It's a bit yukky that we return *renamed* InstInfo, but
-- *non-renamed* auxiliary bindings
; (rn_meth_binds, _fvs) <- discardWarnings $
- bindLocalNames (map varName tyvars) $
+ bindLocalNames (map Var.varName tyvars) $
rnMethodBinds clas_nm (\n -> []) [] meth_binds
-- Build the InstInfo
derivInstCtxt1 clas inst_tys
= ptext SLIT("When deriving the instance for") <+> quotes (pprClassPred clas inst_tys)
-
-derivInstCtxt2 theta clas inst_tys
- = vcat [ptext SLIT("In the derived instance declaration"),
- nest 2 (ptext SLIT("instance") <+> sep [pprThetaArrow theta,
- pprClassPred clas inst_tys])]
\end{code}