+ buildClosures tyvars vvs arg_tys res_ty
+ . hoistPolyVExpr tyvars (maybe_inline (length vs + length bs))
+ $ do
+ lc <- builtin liftingContext
+ (vbndrs, vbody) <- vectBndrsIn (vs ++ bs) (vectExpr body)
+
+ dtrace (text "vbody = " <> ppr vbody) $ return ()
+
+ vbody' <- break_loop lc res_ty vbody
+ return $ vLams lc vbndrs vbody'
+ where
+ maybe_inline n | inline = Inline n
+ | otherwise = DontInline
+
+ break_loop lc ty (ve, le)
+ | loop_breaker
+ = do
+ empty <- emptyPD ty
+ lty <- mkPDataType ty
+ return (ve, mkWildCase (Var lc) intPrimTy lty
+ [(DEFAULT, [], le),
+ (LitAlt (mkMachInt 0), [], empty)])
+
+ | otherwise = return (ve, le)
+
+
+vectTyAppExpr :: CoreExprWithFVs -> [Type] -> VM VExpr
+vectTyAppExpr (_, AnnVar v) tys = vectPolyVar v tys
+vectTyAppExpr e tys = cantVectorise "Can't vectorise expression"
+ (ppr $ deAnnotate e `mkTyApps` tys)
+
+-- 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 :: TyCon -> [Type] -> CoreExprWithFVs -> Var -> Type
+ -> [(AltCon, [Var], CoreExprWithFVs)]
+ -> VM VExpr
+vectAlgCase _tycon _ty_args scrut bndr ty [(DEFAULT, [], body)]
+ = do
+ vscrut <- vectExpr scrut
+ (vty, lty) <- vectAndLiftType ty
+ (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
+ return $ vCaseDEFAULT vscrut vbndr vty lty vbody
+
+vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt _, [], body)]
+ = do
+ vscrut <- vectExpr scrut
+ (vty, lty) <- vectAndLiftType ty
+ (vbndr, vbody) <- vectBndrIn bndr (vectExpr body)
+ return $ vCaseDEFAULT vscrut vbndr vty lty vbody
+
+vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)]
+ = do
+ (vty, lty) <- vectAndLiftType ty
+ vexpr <- vectExpr scrut
+ (vbndr, (vbndrs, (vect_body, lift_body)))
+ <- vect_scrut_bndr
+ . vectBndrsIn bndrs
+ $ vectExpr body
+ let (vect_bndrs, lift_bndrs) = unzip vbndrs
+ (vscrut, lscrut, pdata_tc, _arg_tys) <- mkVScrut (vVar vbndr)
+ vect_dc <- maybeV (lookupDataCon dc)
+ let [pdata_dc] = tyConDataCons pdata_tc
+
+ let vcase = mk_wild_case vscrut vty vect_dc vect_bndrs vect_body
+ lcase = mk_wild_case lscrut lty pdata_dc lift_bndrs lift_body
+
+ return $ vLet (vNonRec vbndr vexpr) (vcase, lcase)