projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Adapt vectoriser to new inlining mechanism
[ghc-hetmet.git]
/
compiler
/
vectorise
/
VectMonad.hs
diff --git
a/compiler/vectorise/VectMonad.hs
b/compiler/vectorise/VectMonad.hs
index
8fdfcdb
..
98701f0
100644
(file)
--- a/
compiler/vectorise/VectMonad.hs
+++ b/
compiler/vectorise/VectMonad.hs
@@
-7,10
+7,11
@@
module VectMonad (
initV, cantVectorise, maybeCantVectorise, maybeCantVectoriseM,
liftDs,
cloneName, cloneId, cloneVar,
initV, cantVectorise, maybeCantVectorise, maybeCantVectoriseM,
liftDs,
cloneName, cloneId, cloneVar,
- newExportedVar, newLocalVar, newDummyVar, newTyVar,
+ newExportedVar, newLocalVar, newLocalVars, newDummyVar, newTyVar,
- Builtins(..), sumTyCon, prodTyCon,
- combinePAVar, scalarZip, closureCtrFun,
+ Builtins(..), sumTyCon, prodTyCon, prodDataCon,
+ selTy, selReplicate, selPick, selTags, selElements,
+ combinePDVar, scalarZip, closureCtrFun,
builtin, builtins,
GlobalEnv(..),
builtin, builtins,
GlobalEnv(..),
@@
-51,7
+52,6
@@
import VarEnv
import Id
import Name
import NameEnv
import Id
import Name
import NameEnv
-import IOEnv ( liftIO )
import DsMonad
import DsMonad
@@
-375,6
+375,9
@@
newLocalVar fs ty
u <- liftDs newUnique
return $ mkSysLocal fs u ty
u <- liftDs newUnique
return $ mkSysLocal fs u ty
+newLocalVars :: FastString -> [Type] -> VM [Var]
+newLocalVars fs = mapM (newLocalVar fs)
+
newDummyVar :: Type -> VM Var
newDummyVar = newLocalVar (fsLit "vv")
newDummyVar :: Type -> VM Var
newDummyVar = newLocalVar (fsLit "vv")
@@
-540,8
+543,6
@@
initV pkg hsc_env guts info p
builtin_vars <- initBuiltinVars builtins
builtin_tycons <- initBuiltinTyCons builtins
let builtin_datacons = initBuiltinDataCons builtins
builtin_vars <- initBuiltinVars builtins
builtin_tycons <- initBuiltinTyCons builtins
let builtin_datacons = initBuiltinDataCons builtins
- builtin_pas <- initBuiltinPAs builtins
- builtin_prs <- initBuiltinPRs builtins
builtin_boxed <- initBuiltinBoxedTyCons builtins
builtin_scalars <- initBuiltinScalars builtins
builtin_boxed <- initBuiltinBoxedTyCons builtins
builtin_scalars <- initBuiltinScalars builtins
@@
-549,6
+550,9
@@
initV pkg hsc_env guts info p
let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
instEnvs = (eps_inst_env eps, mg_inst_env guts)
let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
instEnvs = (eps_inst_env eps, mg_inst_env guts)
+ builtin_prs <- initBuiltinPRs builtins instEnvs
+ builtin_pas <- initBuiltinPAs builtins instEnvs
+
let genv = extendImportedVarsEnv builtin_vars
. extendScalars builtin_scalars
. extendTyConsEnv builtin_tycons
let genv = extendImportedVarsEnv builtin_vars
. extendScalars builtin_scalars
. extendTyConsEnv builtin_tycons