- mapTo vv lv env = env { local_vars = extendVarEnv (local_vars env) v (vv, lv) }
-
-vectBndrIn :: Var -> VM a -> VM (VVar, a)
-vectBndrIn v p
- = localV
- $ do
- vv <- vectBndr v
- x <- p
- return (vv, x)
-
-vectBndrsIn :: [Var] -> VM a -> VM ([VVar], a)
-vectBndrsIn vs p
- = localV
- $ do
- vvs <- mapM vectBndr vs
- x <- p
- return (vvs, x)
-
--- ----------------------------------------------------------------------------
--- Expressions
-
-vectVar :: Var -> Var -> VM VExpr
-vectVar lc v
- = do
- r <- lookupVar v
- case r of
- Local (vv,lv) -> return (Var vv, Var lv)
- Global vv -> do
- let vexpr = Var vv
- lexpr <- replicatePA (Var lc) vexpr
- return (vexpr, lexpr)
-
-vectPolyVar :: Var -> Var -> [Type] -> VM VExpr
-vectPolyVar lc v tys
- = do
- vtys <- mapM vectType tys
- r <- lookupVar v
- case r of
- Local (vv, lv) -> liftM2 (,) (polyApply (Var vv) vtys)
- (polyApply (Var lv) vtys)
- Global poly -> do
- vexpr <- polyApply (Var poly) vtys
- lexpr <- replicatePA (Var lc) vexpr
- return (vexpr, lexpr)
-
-vectLiteral :: Var -> Literal -> VM VExpr
-vectLiteral lc lit
- = do
- lexpr <- replicatePA (Var lc) (Lit lit)
- return (Lit lit, lexpr)
-
-vectPolyExpr :: Var -> CoreExprWithFVs -> VM VExpr
-vectPolyExpr lc expr
- = polyAbstract tvs $ \abstract ->
- -- FIXME: shadowing (tvs in lc)
- do
- mono' <- vectExpr lc mono
- return $ mapVect abstract mono'
- where
- (tvs, mono) = collectAnnTypeBinders expr
-
-vectExpr :: Var -> CoreExprWithFVs -> VM VExpr
-vectExpr lc (_, AnnType ty)
- = liftM vType (vectType ty)
-
-vectExpr lc (_, AnnVar v) = vectVar lc v
-
-vectExpr lc (_, AnnLit lit) = vectLiteral lc lit
-
-vectExpr lc (_, AnnNote note expr)
- = liftM (vNote note) (vectExpr lc expr)