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:
263a30f
)
Utility functions for accessing parallel array representations
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Wed, 8 Aug 2007 04:10:32 +0000
(
04:10
+0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Wed, 8 Aug 2007 04:10:32 +0000
(
04:10
+0000)
compiler/vectorise/VectUtils.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/VectUtils.hs
b/compiler/vectorise/VectUtils.hs
index
f7df277
..
eec57d7
100644
(file)
--- a/
compiler/vectorise/VectUtils.hs
+++ b/
compiler/vectorise/VectUtils.hs
@@
-4,10
+4,10
@@
module VectUtils (
mkDataConTag,
splitClosureTy,
mkPADictType, mkPArrayType,
mkDataConTag,
splitClosureTy,
mkPADictType, mkPArrayType,
+ parrayReprTyCon, parrayReprDataCon,
paDictArgType, paDictOfType, paDFunType,
paMethod, lengthPA, replicatePA, emptyPA, liftPA,
polyAbstract, polyApply, polyVApply,
paDictArgType, paDictOfType, paDFunType,
paMethod, lengthPA, replicatePA, emptyPA, liftPA,
polyAbstract, polyApply, polyVApply,
- lookupPArrayFamInst,
hoistBinding, hoistExpr, hoistPolyVExpr, takeHoisted,
buildClosure, buildClosures,
mkClosureApp
hoistBinding, hoistExpr, hoistPolyVExpr, takeHoisted,
buildClosure, buildClosures,
mkClosureApp
@@
-110,6
+110,16
@@
mkPArrayType ty
tc <- builtin parrayTyCon
return $ TyConApp tc [ty]
tc <- builtin parrayTyCon
return $ TyConApp tc [ty]
+parrayReprTyCon :: Type -> VM (TyCon, [Type])
+parrayReprTyCon ty = builtin parrayTyCon >>= (`lookupFamInst` [ty])
+
+parrayReprDataCon :: Type -> VM (DataCon, [Type])
+parrayReprDataCon ty
+ = do
+ (tc, arg_tys) <- parrayReprTyCon ty
+ let [dc] = tyConDataCons tc
+ return (dc, arg_tys)
+
paDictArgType :: TyVar -> VM (Maybe Type)
paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
where
paDictArgType :: TyVar -> VM (Maybe Type)
paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
where
@@
-226,9
+236,6
@@
polyVApply expr tys
dicts <- mapM paDictOfType tys
return $ mapVect (\e -> e `mkTyApps` tys `mkApps` dicts) expr
dicts <- mapM paDictOfType tys
return $ mapVect (\e -> e `mkTyApps` tys `mkApps` dicts) expr
-lookupPArrayFamInst :: Type -> VM (TyCon, [Type])
-lookupPArrayFamInst ty = builtin parrayTyCon >>= (`lookupFamInst` [ty])
-
hoistBinding :: Var -> CoreExpr -> VM ()
hoistBinding v e = updGEnv $ \env ->
env { global_bindings = (v,e) : global_bindings env }
hoistBinding :: Var -> CoreExpr -> VM ()
hoistBinding v e = updGEnv $ \env ->
env { global_bindings = (v,e) : global_bindings env }
@@
-354,7
+361,7
@@
mkLiftEnv lc [ty] [v]
-- NOTE: this transparently deals with empty environments
mkLiftEnv lc tys vs
= do
-- NOTE: this transparently deals with empty environments
mkLiftEnv lc tys vs
= do
- (env_tc, env_tyargs) <- lookupPArrayFamInst vty
+ (env_tc, env_tyargs) <- parrayReprTyCon vty
let [env_con] = tyConDataCons env_tc
env = Var (dataConWrapId env_con)
let [env_con] = tyConDataCons env_tc
env = Var (dataConWrapId env_con)