projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
9c9ff44
)
Refactor slightly
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 13 Jul 2007 07:33:04 +0000
(07:33 +0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Fri, 13 Jul 2007 07:33:04 +0000
(07:33 +0000)
compiler/vectorise/Vectorise.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/Vectorise.hs
b/compiler/vectorise/Vectorise.hs
index
6ac3d48
..
20f19b6
100644
(file)
--- a/
compiler/vectorise/Vectorise.hs
+++ b/
compiler/vectorise/Vectorise.hs
@@
-124,11
+124,7
@@
vectPolyVar lc v tys
lexpr <- replicateP vexpr lc
return (vexpr, lexpr)
where
lexpr <- replicateP vexpr lc
return (vexpr, lexpr)
where
- mk_app e = do
- vtys <- mapM vectType tys
- dicts <- mapM paDictOfType vtys
- return $ mkApps e [arg | (vty, dict) <- zip vtys dicts
- , arg <- [Type vty, dict]]
+ mk_app e = applyToTypes e =<< mapM vectType tys
abstractOverTyVars :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
abstractOverTyVars tvs p
abstractOverTyVars :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
abstractOverTyVars tvs p
@@
-145,6
+141,13
@@
abstractOverTyVars tvs p
mk_lams mdicts = mkLams [arg | (tv, mdict) <- zip tvs mdicts
, arg <- tv : maybeToList mdict]
mk_lams mdicts = mkLams [arg | (tv, mdict) <- zip tvs mdicts
, arg <- tv : maybeToList mdict]
+
+applyToTypes :: CoreExpr -> [Type] -> VM CoreExpr
+applyToTypes expr tys
+ = do
+ dicts <- mapM paDictOfType tys
+ return $ mkApps expr [arg | (ty, dict) <- zip tys dicts
+ , arg <- [Type ty, dict]]
vectPolyExpr :: CoreExpr -> CoreExprWithFVs -> VM (CoreExpr, CoreExpr)
vectPolyExpr :: CoreExpr -> CoreExprWithFVs -> VM (CoreExpr, CoreExpr)