Commit 8912a05e authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

fix default case filling-in for GADTs

Mon Sep 18 17:04:19 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * fix default case filling-in for GADTs
  Sun Aug  6 20:09:06 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * fix default case filling-in for GADTs
    Fri Jul 28 13:19:40 EDT 2006  kevind@bu.edu
parent 8c9cfd75
......@@ -474,10 +474,6 @@ mkRecordSelId tycon field_label
(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
......
......@@ -1139,28 +1139,6 @@ tryRhsTyLam env tyvars body -- Only does something if there's a let
%* *
%************************************************************************
\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.
......
......@@ -1553,7 +1553,10 @@ simplDefault env case_bndr' imposs_cons cont (Just rhs)
[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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment