- lc_bndr <- newLocalVar FSLIT("lc") intPrimTy
- (varg : vbndrs, larg : lbndrs, (vbody, lbody))
- <- vectBndrsIn (arg : cenv_vars info)
- (vectExpr (Var lc_bndr) body)
-
- venv_bndr <- newLocalVar FSLIT("env") vty
- lenv_bndr <- newLocalVar FSLIT("env") lty
-
- let vcase = bind_venv (Var venv_bndr) vbody vbndrs
- lcase <- bind_lenv (Var lenv_bndr) lbody lc_bndr lbndrs
- return (mkLams [venv_bndr, varg] vcase, mkLams [lenv_bndr, larg] lcase)
- where
- vty = cenv_vty info
- lty = cenv_lty info
-
- arity = length (cenv_vars info)
-
- bind_venv venv vbody [] = vbody
- bind_venv venv vbody [vbndr] = Let (NonRec vbndr venv) vbody
- bind_venv venv vbody vbndrs
- = Case venv (mkWildId vty) (exprType vbody)
- [(DataAlt (tupleCon Boxed arity), vbndrs, vbody)]
-
- bind_lenv lenv lbody lc_bndr [lbndr]
- = do
- lengthPA <- builtin lengthPAVar
- pa_dict <- paDictOfType vty
- return . Let (NonRec lbndr lenv)
- $ Case (mkApps (Var lengthPA) [Type vty, pa_dict, (Var lbndr)])
- lc_bndr
- (exprType lbody)
- [(DEFAULT, [], lbody)]
-
- bind_lenv lenv lbody lc_bndr lbndrs
- = let scrut = unwrapFamInstScrut (cenv_repr_tycon info)
- (cenv_repr_tyargs info)
- lenv
- lbndrs' | null lbndrs = [mkWildId unitTy]
- | otherwise = lbndrs
- in
- return
- $ Case scrut
- (mkWildId (exprType scrut))
- (exprType lbody)
- [(DataAlt (cenv_repr_datacon info), lc_bndr : lbndrs', lbody)]
-
-vectTyAppExpr :: CoreExpr -> CoreExprWithFVs -> [Type] -> VM (CoreExpr, CoreExpr)
-vectTyAppExpr lc (_, AnnVar v) tys = vectPolyVar lc v tys
-vectTyAppExpr lc e tys = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e)
-
--- ----------------------------------------------------------------------------
--- Types
-
-
+ vty <- vectType ty
+ lty <- mkPArrayType vty
+ vexpr <- vectExpr scrut
+ (vbndr, (vbndrs, vbody)) <- vectBndrIn 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