-vectExpr e@(fvs, AnnLam bndr _)
- | not (isId bndr) = pprPanic "vectExpr" (ppr $ deAnnotate e)
- | otherwise = vectLam fvs bs body
- where
- (bs,body) = collectAnnValBinders e
-
-vectLam :: VarSet -> [Var] -> CoreExprWithFVs -> VM VExpr
-vectLam fvs bs body
- = do
- tyvars <- localTyVars
- (vs, vvs) <- readLEnv $ \env ->
- unzip [(var, vv) | var <- varSetElems fvs
- , Just vv <- [lookupVarEnv (local_vars env) var]]
-
- arg_tys <- mapM (vectType . idType) bs
- res_ty <- vectType (exprType $ deAnnotate body)
-
- buildClosures tyvars vvs arg_tys res_ty
- . hoistPolyVExpr tyvars
- $ do
- lc <- builtin liftingContext
- (vbndrs, vbody) <- vectBndrsIn (vs ++ bs)
- (vectExpr body)
- return $ vLams lc vbndrs vbody
-
-vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr
-vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys
-vectTyAppExpr e tys = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e)
-
-type CoreAltWithFVs = AnnAlt Id VarSet
-
--- We convert
---
--- case e :: t of v { ... }
---
--- to
---
--- V: let v' = e in case v' of _ { ... }
--- L: let v' = e in case v' `cast` ... of _ { ... }
---
--- When lifting, we have to do it this way because v must have the type
--- [:V(T):] but the scrutinee must be cast to the representation type. We also
--- have to handle the case where v is a wild var correctly.
---
-
--- FIXME: this is too lazy
-vectAlgCase scrut bndr ty [(DEFAULT, [], body)]
- = do
- vscrut <- vectExpr scrut
- vty <- vectType ty
- lty <- mkPArrayType vty
- (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
- return $ vCaseDEFAULT vscrut vbndr vty lty vbody
-
-vectAlgCase scrut bndr ty [(DataAlt dc, bndrs, body)]
- = do
- vty <- vectType ty
- lty <- mkPArrayType vty
- vexpr <- vectExpr scrut
- (vbndr, (vbndrs, vbody)) <- vect_scrut_bndr
- . vectBndrsIn bndrs
- $ vectExpr body
-
- (vscrut, arr_tc, arg_tys) <- mkVScrut (vVar vbndr)
- vect_dc <- maybeV (lookupDataCon dc)
- let [arr_dc] = tyConDataCons arr_tc
- let shape_tys = take (dataConRepArity arr_dc - length bndrs)
- (dataConRepArgTys arr_dc)
- shape_bndrs <- mapM (newLocalVar FSLIT("s")) shape_tys
- return . vLet (vNonRec vbndr vexpr)
- $ vCaseProd vscrut vty lty vect_dc arr_dc shape_bndrs vbndrs vbody
- where
- vect_scrut_bndr | isDeadBinder bndr = vectBndrNewIn bndr FSLIT("scrut")
- | otherwise = vectBndrIn bndr
+vectTopRhs var expr
+ = dtrace (vcat [text "vectTopRhs", ppr expr])
+ $ closedV
+ $ do (inline, vexpr) <- inBind var
+ $ vectPolyExpr (isLoopBreaker $ idOccInfo var)
+ (freeVars expr)
+ return (inline, vectorised vexpr)
+
+
+-- | Project out the vectorised version of a binding from some closure,
+-- or return the original body if that doesn't work.
+tryConvert
+ :: Var -- ^ Name of the original binding (eg @foo@)
+ -> Var -- ^ Name of vectorised version of binding (eg @$vfoo@)
+ -> CoreExpr -- ^ The original body of the binding.
+ -> VM CoreExpr
+
+tryConvert var vect_var rhs
+ = fromVect (idType var) (Var vect_var) `orElseV` return rhs