--
-- (1) create a coercion that identifies the family instance type and the
-- representation type from Step (1); ie, it is of the form
--- `Co tvs :: F ts :=: R tvs', where `Co' is the name of the coercion,
+-- `Co tvs :: F ts ~ R tvs', where `Co' is the name of the coercion,
-- `F' the family tycon and `R' the (derived) representation tycon,
-- and
-- (2) produce a `TyConParent' value containing the parent and coercion
-- non-recursive newtypes
all_coercions = True
tvs = tyConTyVars tycon
- rhs_ty = ASSERT(not (null (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs))))
- -- head (dataConInstOrigArgTys con (mkTyVarTys tvs))
- head (dataConInstOrigDictsAndArgTys con (mkTyVarTys tvs))
+ inst_con_ty = applyTys (dataConUserType con) (mkTyVarTys tvs)
+ rhs_ty = ASSERT( isFunTy inst_con_ty ) funArgTy inst_con_ty
-- Instantiate the data con with the
-- type variables from the tycon
- -- NB: a newtype DataCon has no existentials; hence the
- -- call to dataConInstOrigArgTys has the right type args
+ -- NB: a newtype DataCon has a type that must look like
+ -- forall tvs. <arg-ty> -> T tvs
+ -- Note that we *can't* use dataConInstOrigArgTys here because
+ -- the newtype arising from class Foo a => Bar a where {}
+ -- has a single argument (Foo a) that is a *type class*, so
+ -- dataConInstOrigArgTys returns [].
etad_tvs :: [TyVar] -- Matched lazily, so that mkNewTypeCoercion can
etad_rhs :: Type -- return a TyCon without pulling on rhs_ty
-> [(TyVar,Type)] -- Equality spec
-> ThetaType -- Does not include the "stupid theta"
-- or the GADT equalities
- -> [Type] -> TyCon
+ -> [Type] -> Type -- Argument and result types
+ -> TyCon -- Rep tycon
-> TcRnIf m n DataCon
-- A wrapper for DataCon.mkDataCon that
-- a) makes the worker Id
-- b) makes the wrapper Id if necessary, including
-- allocating its unique (hence monadic)
buildDataCon src_name declared_infix arg_stricts field_lbls
- univ_tvs ex_tvs eq_spec ctxt arg_tys tycon
+ univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
= do { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
-- This last one takes the name of the data constructor in the source
-- space, and puts it into the VarName name space
; let
- stupid_ctxt = mkDataConStupidTheta tycon arg_tys univ_tvs
+ stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
data_con = mkDataCon src_name declared_infix
arg_stricts field_lbls
univ_tvs ex_tvs eq_spec ctxt
- arg_tys tycon
+ arg_tys res_ty rep_tycon
stupid_ctxt dc_ids
dc_ids = mkDataConIds wrap_name work_name data_con
[{- No labelled fields -}]
tvs [{- no existentials -}]
[{- No GADT equalities -}] sc_theta
- op_tys
+ op_tys
+ (mkTyConApp rec_tycon (mkTyVarTys tvs))
rec_tycon
; let n_value_preds = count (not . isEqPred) sc_theta