projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use packByTag instead of pack in the vectoriser
[ghc-hetmet.git]
/
compiler
/
vectorise
/
VectUtils.hs
diff --git
a/compiler/vectorise/VectUtils.hs
b/compiler/vectorise/VectUtils.hs
index
caa4f40
..
e508424
100644
(file)
--- a/
compiler/vectorise/VectUtils.hs
+++ b/
compiler/vectorise/VectUtils.hs
@@
-11,7
+11,7
@@
module VectUtils (
pdataReprTyCon, pdataReprDataCon, mkVScrut,
prDictOfType, prDFunOfTyCon,
paDictArgType, paDictOfType, paDFunType,
pdataReprTyCon, pdataReprDataCon, mkVScrut,
prDictOfType, prDFunOfTyCon,
paDictArgType, paDictOfType, paDFunType,
- paMethod, wrapPR, replicatePD, emptyPD, packPD,
+ paMethod, wrapPR, replicatePD, emptyPD, packPD, packByTagPD,
combinePD,
liftPD,
zipScalars, scalarClosure,
combinePD,
liftPD,
zipScalars, scalarClosure,
@@
-98,7
+98,7
@@
mkBuiltinTyConApps get_tc tys ty
mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
voidType :: VM Type
mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
voidType :: VM Type
-voidType = mkBuiltinTyConApp voidTyCon []
+voidType = mkBuiltinTyConApp VectMonad.voidTyCon []
mkWrapType :: Type -> VM Type
mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
mkWrapType :: Type -> VM Type
mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
@@
-241,9
+241,9
@@
prDictOfTyApp ty_fn ty_args
| Just ty_fn' <- coreView ty_fn = prDictOfTyApp ty_fn' ty_args
prDictOfTyApp (TyConApp tc _) ty_args
= do
| Just ty_fn' <- coreView ty_fn = prDictOfTyApp ty_fn' ty_args
prDictOfTyApp (TyConApp tc _) ty_args
= do
- dfun <- prDFunOfTyCon tc
+ dfun <- liftM Var $ maybeV (lookupTyConPR tc)
prDFunApply dfun ty_args
prDFunApply dfun ty_args
-prDictOfTyApp ty _ = noV
+prDictOfTyApp _ _ = noV
prDFunApply :: CoreExpr -> [Type] -> VM CoreExpr
prDFunApply dfun tys
prDFunApply :: CoreExpr -> [Type] -> VM CoreExpr
prDFunApply dfun tys
@@
-269,6
+269,12
@@
packPD :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> VM CoreExpr
packPD ty xs len sel = liftM (`mkApps` [xs, len, sel])
(paMethod packPDVar "packPD" ty)
packPD ty xs len sel = liftM (`mkApps` [xs, len, sel])
(paMethod packPDVar "packPD" ty)
+packByTagPD :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
+ -> VM CoreExpr
+packByTagPD ty xs len tags t
+ = liftM (`mkApps` [xs, len, tags, t])
+ (paMethod packByTagPDVar "packByTagPD" ty)
+
combinePD :: Type -> CoreExpr -> CoreExpr -> [CoreExpr]
-> VM CoreExpr
combinePD ty len sel xs
combinePD :: Type -> CoreExpr -> CoreExpr -> [CoreExpr]
-> VM CoreExpr
combinePD ty len sel xs