exprIsConApp_maybe, mkPiTypes, findAlt,
exprType, exprIsHNF, findDefault, mergeAlts,
exprOkForSpeculation, exprArity,
- mkCoerce, mkSCC, mkInlineMe, applyTypeToArg
+ mkCoerce, mkSCC, mkInlineMe, applyTypeToArg,
+ dataConInstPat
)
import Rules ( lookupRule )
import BasicTypes ( isMarkedStrict )
-- means that we can avoid tests in exprIsConApp, for example.
-- This is important: if exprIsConApp says 'yes' for a recursive
-- thing, then we can get into an infinite loop
-
-- If the unfolding is a value, the demand info may
-- go pear-shaped, so we nuke it. Example:
-- let x = (a,b) in
simplDefault env case_bndr' imposs_cons cont Nothing
= return [] -- No default branch
+
simplDefault env case_bndr' imposs_cons cont (Just rhs)
| -- This branch handles the case where we are
-- scrutinisng an algebraic data type
[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
two_or_more -> simplify_default (map DataAlt gadt_imposs ++ imposs_cons)
- | otherwise
+ | otherwise
= simplify_default imposs_cons
where
cant_match tys data_con = not (dataConCanMatch data_con tys)
simplExprF env rhs cont
(DataAlt dc, bs, rhs)
- -> ASSERT( n_drop_tys + length bs == length args )
+ -> -- ASSERT( n_drop_tys + length bs == length args )
bind_args env dead_bndr bs (drop n_drop_tys args) $ \ env ->
let
-- It's useful to bind bndr to scrut, rather than to a fresh