(field_tyvars,pre_field_theta,field_tau) = tcSplitSigmaTy field_ty
- mk_co_var k = mkWildCoVar k
- eq_vars = map (mk_co_var . mkPredTy)
- (filter isEqPred pre_field_theta)
-
field_theta = filter (not . isEqPred) pre_field_theta
field_dict_tys = mkPredTys field_theta
n_field_dict_tys = length field_dict_tys
%* *
%************************************************************************
-\begin{code}
-mkDataConAlt :: DataCon -> [OutType] -> InExpr -> SimplM InAlt
--- Make a data-constructor alternative to replace the DEFAULT case
--- NB: there's something a bit bogus here, because we put OutTypes into an InAlt
-mkDataConAlt con inst_tys rhs
- = ASSERT(not (isNewTyCon (dataConTyCon con)))
- do { tv_uniqs <- getUniquesSmpl
- ; arg_uniqs <- getUniquesSmpl
- ; let tv_bndrs = zipWith mk_tv_bndr (dataConExTyVars con) tv_uniqs
- arg_tys = dataConInstArgTys con (inst_tys ++ mkTyVarTys tv_bndrs)
- arg_bndrs = zipWith mk_arg arg_tys arg_uniqs
- ; return (DataAlt con, tv_bndrs ++ arg_bndrs, rhs) }
- where
- mk_arg arg_ty uniq -- Equality predicates get a TyVar
- -- while dictionaries and others get an Id
- | isEqPredTy arg_ty = mk_tv arg_ty uniq
- | otherwise = mk_id arg_ty uniq
-
- mk_tv_bndr tv uniq = mk_tv (tyVarKind tv) uniq
- mk_tv kind uniq = mkTyVar (mkSysTvName uniq FSLIT("t")) kind
- mk_id ty uniq = mkSysLocal FSLIT("a") uniq ty
-\end{code}
mkCase puts a case expression back together, trying various transformations first.
[con] -> -- It matches exactly one constructor, so fill it in
do { tick (FillInCaseDefault case_bndr')
- ; con_alt <- mkDataConAlt con inst_tys rhs
+ ; us <- getUniquesSmpl
+ ; let (ex_tvs, co_tvs, arg_ids) =
+ dataConInstPat us con inst_tys
+ ; let con_alt = (DataAlt con, ex_tvs ++ co_tvs ++ arg_ids, rhs)
; Just (_, alt') <- simplAlt env [] case_bndr' cont con_alt
-- The simplAlt must succeed with Just because we have
-- already filtered out construtors that can't match