+-- ----------------------------------------------------------------------------
+-- Vectorisation monad
+
+data Builtins = Builtins {
+ parrayTyCon :: TyCon
+ , paTyCon :: TyCon
+ , closureTyCon :: TyCon
+ , mkClosureVar :: Var
+ , applyClosureVar :: Var
+ , mkClosurePVar :: Var
+ , applyClosurePVar :: Var
+ , closurePAVar :: Var
+ , lengthPAVar :: Var
+ , replicatePAVar :: Var
+ }
+
+initBuiltins :: DsM Builtins
+initBuiltins
+ = do
+ parrayTyCon <- dsLookupTyCon parrayTyConName
+ paTyCon <- dsLookupTyCon paTyConName
+ closureTyCon <- dsLookupTyCon closureTyConName
+
+ mkClosureVar <- dsLookupGlobalId mkClosureName
+ applyClosureVar <- dsLookupGlobalId applyClosureName
+ mkClosurePVar <- dsLookupGlobalId mkClosurePName
+ applyClosurePVar <- dsLookupGlobalId applyClosurePName
+ closurePAVar <- dsLookupGlobalId closurePAName
+ lengthPAVar <- dsLookupGlobalId lengthPAName
+ replicatePAVar <- dsLookupGlobalId replicatePAName
+
+ return $ Builtins {
+ parrayTyCon = parrayTyCon
+ , paTyCon = paTyCon
+ , closureTyCon = closureTyCon
+ , mkClosureVar = mkClosureVar
+ , applyClosureVar = applyClosureVar
+ , mkClosurePVar = mkClosurePVar
+ , applyClosurePVar = applyClosurePVar
+ , closurePAVar = closurePAVar
+ , lengthPAVar = lengthPAVar
+ , replicatePAVar = replicatePAVar
+ }
+
+data VEnv = VEnv {
+ -- Mapping from variables to their vectorised versions
+ --
+ vect_vars :: VarEnv Var
+ }
+
+initVEnv :: VectInfo -> DsM VEnv
+initVEnv info
+ = return $ VEnv {
+ vect_vars = mapVarEnv snd $ vectInfoCCVar info
+ }
+
+-- FIXME
+updVectInfo :: VEnv -> VectInfo -> VectInfo
+updVectInfo env info = info
+
+newtype VM a = VM { runVM :: Builtins -> VEnv -> DsM (VEnv, a) }
+
+instance Monad VM where
+ return x = VM $ \bi env -> return (env, x)
+ VM p >>= f = VM $ \bi env -> do
+ (env', x) <- p bi env
+ runVM (f x) bi env'
+
+vectoriseModule :: VectInfo -> ModGuts -> DsM ModGuts
+vectoriseModule info guts
+ = do
+ builtins <- initBuiltins
+ env <- initVEnv info
+ (env', guts') <- runVM (vectModule guts) builtins env
+ return $ guts' { mg_vect_info = updVectInfo env' info }
+
+vectModule :: ModGuts -> VM ModGuts
+vectModule guts = return guts
+