import Inst ( InstOrigin(..), InstanceMapper(..) )
import TcEnv ( getEnv_TyCons )
import TcKind ( TcKind )
import Inst ( InstOrigin(..), InstanceMapper(..) )
import TcEnv ( getEnv_TyCons )
import TcKind ( TcKind )
import TcInstUtil ( InstInfo(..), mkInstanceRelatedIds, buildInstanceEnvs )
import TcSimplify ( tcSimplifyThetas )
import TcInstUtil ( InstInfo(..), mkInstanceRelatedIds, buildInstanceEnvs )
import TcSimplify ( tcSimplifyThetas )
-import Bag ( Bag, isEmptyBag, unionBags, listToBag )
+import Bag ( emptyBag{-ToDo:rm-}, Bag, isEmptyBag, unionBags, listToBag )
-import ErrUtils ( pprBagOfErrors, addErrLoc, TcError(..) )
-import Id ( getDataConSig, getDataConArity )
+import CmdLineOpts ( opt_CompilingPrelude )
+import ErrUtils ( pprBagOfErrors, addErrLoc, Error(..) )
+import Id ( dataConSig, dataConArity )
import Outputable
import PprType ( GenType, GenTyVar, GenClass, TyCon )
import PprStyle
import Pretty
import Outputable
import PprType ( GenType, GenTyVar, GenClass, TyCon )
import PprStyle
import Pretty
-import TyCon ( getTyConTyVars, getTyConDataCons, getTyConDerivings,
+import TyCon ( tyConTyVars, tyConDataCons, tyConDerivings,
maybeTyConSingleCon, isEnumerationTyCon, TyCon )
import Type ( GenType(..), TauType(..), mkTyVarTys, applyTyCon,
mkSigmaTy, mkDictTy, isPrimType, instantiateTy,
maybeTyConSingleCon, isEnumerationTyCon, TyCon )
import Type ( GenType(..), TauType(..), mkTyVarTys, applyTyCon,
mkSigmaTy, mkDictTy, isPrimType, instantiateTy,
-> GlobalNameMappers -- for "renaming" bits of generated code
-> Bag InstInfo -- What we already know about instances
-> [RenamedFixityDecl] -- Fixity info; used by Read and Show
-> GlobalNameMappers -- for "renaming" bits of generated code
-> Bag InstInfo -- What we already know about instances
-> [RenamedFixityDecl] -- Fixity info; used by Read and Show
-- for debugging via -ddump-derivings.
tcDeriving modname renamer_name_funs inst_decl_infos_in fixities
-- for debugging via -ddump-derivings.
tcDeriving modname renamer_name_funs inst_decl_infos_in fixities
= -- Fish the "deriving"-related information out of the TcEnv
-- and make the necessary "equations".
makeDerivEqns `thenTc` \ eqns ->
= -- Fish the "deriving"-related information out of the TcEnv
-- and make the necessary "equations".
makeDerivEqns `thenTc` \ eqns ->
-- Take the equation list and solve it, to deliver a list of
-- solutions, a.k.a. the contexts for the instance decls
-- required for the corresponding equations.
-- Take the equation list and solve it, to deliver a list of
-- solutions, a.k.a. the contexts for the instance decls
-- required for the corresponding equations.
`thenTc` \ new_inst_infos ->
-- Now augment the InstInfos, adding in the rather boring
`thenTc` \ new_inst_infos ->
-- Now augment the InstInfos, adding in the rather boring
`thenTc` \ really_new_inst_infos ->
returnTc (listToBag really_new_inst_infos,
extra_binds,
ddump_deriving really_new_inst_infos extra_binds)
where
`thenTc` \ really_new_inst_infos ->
returnTc (listToBag really_new_inst_infos,
extra_binds,
ddump_deriving really_new_inst_infos extra_binds)
where
ddump_deriving :: [InstInfo] -> RenamedHsBinds -> (PprStyle -> Pretty)
ddump_deriving inst_infos extra_binds sty
ddump_deriving :: [InstInfo] -> RenamedHsBinds -> (PprStyle -> Pretty)
ddump_deriving inst_infos extra_binds sty
mk_eqn (clas, tycon)
= (clas, tycon, tyvars, constraints)
where
mk_eqn (clas, tycon)
= (clas, tycon, tyvars, constraints)
where
- (con_tyvars, _, arg_tys, _) = getDataConSig data_con
+ (con_tyvars, _, arg_tys, _) = dataConSig data_con
= -- Extend the inst info from the explicit instance decls
-- with the current set of solutions, giving a
= -- Extend the inst info from the explicit instance decls
-- with the current set of solutions, giving a
`thenTc` \ (new_inst_infos, inst_mapper) ->
-- Simplify each RHS, using a DerivingOrigin containing an
`thenTc` \ (new_inst_infos, inst_mapper) ->
-- Simplify each RHS, using a DerivingOrigin containing an
-- the eqns and solns move "in lockstep"; we have the eqns
-- because we need the LHS info for addClassInstance.
-- the eqns and solns move "in lockstep"; we have the eqns
-- because we need the LHS info for addClassInstance.
= buildInstanceEnvs all_inst_infos `thenTc` \ inst_mapper ->
returnTc (new_inst_infos, inst_mapper)
where
= buildInstanceEnvs all_inst_infos `thenTc` \ inst_mapper ->
returnTc (new_inst_infos, inst_mapper)
where
-> [RenamedFixityDecl] -- all known fixities;
-- may be needed for Text
-> GlobalNameMappers -- lookup stuff for names we may use
-> [RenamedFixityDecl] -- all known fixities;
-- may be needed for Text
-> GlobalNameMappers -- lookup stuff for names we may use
- -> [(ProtoName, Name, TyCon, TagThingWanted)]
+ -> [(RdrName, RnName, TyCon, TagThingWanted)]
|| (we_are_deriving ordClassKey tycon
&& not (maybeToBool (maybeTyConSingleCon tycon)))
|| (we_are_deriving enumClassKey tycon)
|| (we_are_deriving ordClassKey tycon
&& not (maybeToBool (maybeTyConSingleCon tycon)))
|| (we_are_deriving enumClassKey tycon)
derivingEnumErr tycon
= addErrLoc (getSrcLoc tycon) "Can't derive an instance of `Enum'" ( \ sty ->
ppBesides [ppStr "type `", ppr sty tycon, ppStr "'"] )
derivingEnumErr tycon
= addErrLoc (getSrcLoc tycon) "Can't derive an instance of `Enum'" ( \ sty ->
ppBesides [ppStr "type `", ppr sty tycon, ppStr "'"] )
derivingIxErr tycon
= addErrLoc (getSrcLoc tycon) "Can't derive an instance of `Ix'" ( \ sty ->
ppBesides [ppStr "type `", ppr sty tycon, ppStr "'"] )
derivingIxErr tycon
= addErrLoc (getSrcLoc tycon) "Can't derive an instance of `Ix'" ( \ sty ->
ppBesides [ppStr "type `", ppr sty tycon, ppStr "'"] )