X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=71ba7a38acbeeef76d3ccc9cfa945edb2aff3b56;hb=4e105ef54da56080ce6ec27c8ca61c63171be009;hp=0d200a8ccbdfcdccdf595d5634dfd0090f9f1445;hpb=76fb33900748c86d97aa528bae91cd1844aed97d;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 0d200a8..71ba7a3 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -43,7 +43,7 @@ isAnnTypeArg (_, AnnType t) = True isAnnTypeArg _ = False isClosureTyCon :: TyCon -> Bool -isClosureTyCon tc = tyConUnique tc == closureTyConKey +isClosureTyCon tc = tyConName tc == closureTyConName splitClosureTy :: Type -> (Type, Type) splitClosureTy ty @@ -53,6 +53,17 @@ splitClosureTy ty | otherwise = pprPanic "splitClosureTy" (ppr ty) +isPArrayTyCon :: TyCon -> Bool +isPArrayTyCon tc = tyConName tc == parrayTyConName + +splitPArrayTy :: Type -> Type +splitPArrayTy ty + | Just (tc, [arg_ty]) <- splitTyConApp_maybe ty + , isPArrayTyCon tc + = arg_ty + + | otherwise = pprPanic "splitPArrayTy" (ppr ty) + mkPADictType :: Type -> VM Type mkPADictType ty = do @@ -118,7 +129,9 @@ paMethod method ty return $ mkApps (Var fn) [Type ty, dict] lengthPA :: CoreExpr -> VM CoreExpr -lengthPA x = liftM (`App` x) (paMethod lengthPAVar (exprType x)) +lengthPA x = liftM (`App` x) (paMethod lengthPAVar ty) + where + ty = splitPArrayTy (exprType x) replicatePA :: CoreExpr -> CoreExpr -> VM CoreExpr replicatePA len x = liftM (`mkApps` [len,x])