- body | null sc_dicts = coerced_rep_dict
- | otherwise = HsCase coerced_rep_dict $
- MatchGroup [the_match] inst_head
- the_match = mkSimpleMatch [the_pat] the_rhs
- op_ids = zipWith (mkSysLocal FSLIT("op"))
- (uniqsFromSupply uniqs) op_tys
- the_pat = ConPatOut { pat_con = cls_data_con, pat_tvs = [],
- pat_dicts = map (WildPat . idType) sc_dict_ids,
- pat_binds = emptyDictBinds,
- pat_args = PrefixCon (map VarPat op_ids),
- pat_ty = <type of pattern> }
- the_rhs = mkHsApps (dataConWrapId cls_data_con) types sc_dict_ids (map HsVar op_ids)
-
- ; return (unitBag (VarBind dfun_id (mkHsCoerce wrap_fn body))) }
- where
- co_fn :: ExprCoFn
- co_fn | Just co_con <- newTyConCo tycon
- = ExprCoFn (mkAppCoercion (mkAppsCoercion tycon rep_tys)
- (mkTyConApp co_con tvs))
- | otherwise
- = idCoerecion
-
-tcMethods origin clas inst_tyvars' dfun_theta' inst_tys'
- avail_insts op_items (NewTypeDerived rep_tys)
- = getInstLoc origin `thenM` \ inst_loc ->
- mapAndUnzip3M (do_one inst_loc) op_items `thenM` \ (meth_ids, meth_binds, rhs_insts) ->
-
- tcSimplifyCheck
- (ptext SLIT("newtype derived instance"))
- inst_tyvars' avail_insts rhs_insts `thenM` \ lie_binds ->
+ body | null sc_dict_ids = coerced_rep_dict
+ | otherwise = HsCase (noLoc coerced_rep_dict) $
+ MatchGroup [the_match] (mkFunTy in_dict_ty inst_head)
+ in_dict_ty = mkTyConApp cls_tycon cls_inst_tys