diff options
| author | simonpj@microsoft.com <unknown> | 2007-12-21 08:55:42 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2007-12-21 08:55:42 +0000 |
| commit | f645bca8386cd70021cdd467a423b49b7daa835b (patch) | |
| tree | 11fbac0f79481403415dd465e5667f8b63e655be /compiler/stgSyn | |
| parent | e4828ab96fc2ba5250a6676e4c1653602f8846c7 (diff) | |
| download | haskell-f645bca8386cd70021cdd467a423b49b7daa835b.tar.gz | |
Fix Trac #1981: seq on a type-family-typed expression
We were crashing when we saw
case x of DEFAULT -> rhs
where x had a type-family type. This patch fixes it.
MERGE to the 6.8 branch.
Diffstat (limited to 'compiler/stgSyn')
| -rw-r--r-- | compiler/stgSyn/CoreToStg.lhs | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs index 91c9a2013e..40023bf363 100644 --- a/compiler/stgSyn/CoreToStg.lhs +++ b/compiler/stgSyn/CoreToStg.lhs @@ -371,7 +371,7 @@ coreToStgExpr (Case scrut bndr _ alts) (getLiveVars alts_lv_info) bndr' (mkSRT alts_lv_info) - (mkStgAltType (idType bndr) alts) + (mkStgAltType bndr alts) alts2, scrut_fvs `unionFVInfo` alts_fvs_wo_bndr, alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs @@ -411,21 +411,27 @@ coreToStgExpr (Let bind body) \end{code} \begin{code} -mkStgAltType scrut_ty alts - = case splitTyConApp_maybe (repType scrut_ty) of +mkStgAltType bndr alts + = case splitTyConApp_maybe (repType (idType bndr)) of Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc | isUnLiftedTyCon tc -> PrimAlt tc | isHiBootTyCon tc -> look_for_better_tycon | isAlgTyCon tc -> AlgAlt tc - | isFunTyCon tc -> PolyAlt - | isPrimTyCon tc -> PolyAlt -- for "Any" - | otherwise -> pprPanic "mkStgAlts" (ppr tc) + | otherwise -> ASSERT( _is_poly_alt_tycon tc ) + PolyAlt Nothing -> PolyAlt where - -- Sometimes, the TyCon in the type of the scrutinee is an HiBootTyCon, - -- which may not have any constructors inside it. If so, then we - -- can get a better TyCon by grabbing the one from a constructor alternative + _is_poly_alt_tycon tc + = isFunTyCon tc + || isPrimTyCon tc -- "Any" is lifted but primitive + || isOpenTyCon tc -- Type family; e.g. arising from strict + -- function application where argument has a + -- type-family type + + -- Sometimes, the TyCon is a HiBootTyCon which may not have any + -- constructors inside it. Then we can get a better TyCon by + -- grabbing the one from a constructor alternative -- if one exists. look_for_better_tycon | ((DataAlt con, _, _) : _) <- data_alts = |