summaryrefslogtreecommitdiff
path: root/compiler/stgSyn/CoreToStg.lhs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/stgSyn/CoreToStg.lhs')
-rw-r--r--compiler/stgSyn/CoreToStg.lhs21
1 files changed, 11 insertions, 10 deletions
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index d923f68887..6dc091961a 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -454,15 +454,15 @@ coreToStgExpr e = pprPanic "coreToStgExpr" (ppr e)
\begin{code}
mkStgAltType :: Id -> [CoreAlt] -> AltType
-mkStgAltType bndr alts
- = case tyConAppTyCon_maybe (repType (idType bndr)) of
- Just tc | isUnboxedTupleTyCon tc -> UbxTupAlt tc
- | isUnLiftedTyCon tc -> PrimAlt tc
- | isAbstractTyCon tc -> look_for_better_tycon
- | isAlgTyCon tc -> AlgAlt tc
- | otherwise -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
- PolyAlt
- Nothing -> PolyAlt
+mkStgAltType bndr alts = case repType (idType bndr) of
+ UnaryRep rep_ty -> case tyConAppTyCon_maybe rep_ty of
+ Just tc | isUnLiftedTyCon tc -> PrimAlt tc
+ | isAbstractTyCon tc -> look_for_better_tycon
+ | isAlgTyCon tc -> AlgAlt tc
+ | otherwise -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
+ PolyAlt
+ Nothing -> PolyAlt
+ UbxTupleRep rep_tys -> UbxTupAlt (length rep_tys)
where
_is_poly_alt_tycon tc
@@ -623,7 +623,8 @@ coreToStgArgs (arg : args) = do -- Non-type argument
arg_ty = exprType arg
stg_arg_ty = stgArgType stg_arg
bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty))
- || (typePrimRep arg_ty /= typePrimRep stg_arg_ty)
+ || (map typePrimRep (flattenRepType (repType arg_ty))
+ /= map typePrimRep (flattenRepType (repType stg_arg_ty)))
-- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted),
-- and pass it to a function expecting an HValue (arg_ty). This is ok because
-- we can treat an unlifted value as lifted. But the other way round