diff options
Diffstat (limited to 'compiler/stgSyn/CoreToStg.lhs')
-rw-r--r-- | compiler/stgSyn/CoreToStg.lhs | 21 |
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 |