mkStgAltType: try to find the non-abstract TyCon if the one in the
type of the case binder turns out to be an HiBootTyCon. Fixes
possible code generation bugs when compiling programs with recursive
modules.
#include "HsVersions.h"
import CoreSyn
#include "HsVersions.h"
import CoreSyn
-import CoreUtils ( rhsIsStatic, manifestArity, exprType )
+import CoreUtils ( rhsIsStatic, manifestArity, exprType, findDefault )
import StgSyn
import Type
import StgSyn
import Type
(getLiveVars alts_lv_info)
bndr'
(mkSRT alts_lv_info)
(getLiveVars alts_lv_info)
bndr'
(mkSRT alts_lv_info)
- (mkStgAltType (idType bndr))
+ (mkStgAltType (idType bndr) alts)
alts2,
scrut_fvs `unionFVInfo` alts_fvs_wo_bndr,
alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs
alts2,
scrut_fvs `unionFVInfo` alts_fvs_wo_bndr,
alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs
+mkStgAltType scrut_ty alts
= case splitTyConApp_maybe (repType scrut_ty) of
Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
| isPrimTyCon tc -> PrimAlt tc
= case splitTyConApp_maybe (repType scrut_ty) of
Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
| isPrimTyCon tc -> PrimAlt tc
- | isHiBootTyCon tc -> PolyAlt -- Algebraic, but no constructors visible
+ | isHiBootTyCon tc -> look_for_better_tycon
| isAlgTyCon tc -> AlgAlt tc
| isFunTyCon tc -> PolyAlt
| otherwise -> pprPanic "mkStgAlts" (ppr tc)
Nothing -> PolyAlt
| isAlgTyCon tc -> AlgAlt tc
| isFunTyCon tc -> PolyAlt
| otherwise -> pprPanic "mkStgAlts" (ppr tc)
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
+ -- if one exists.
+ look_for_better_tycon
+ | ((DataAlt con, _, _) : _) <- data_alts =
+ AlgAlt (dataConTyCon con)
+ | otherwise =
+ ASSERT(null data_alts)
+ PolyAlt
+ where
+ (data_alts, deflt) = findDefault alts