+
+vectExpr lc e@(_, AnnLam bndr body)
+ | isTyVar bndr = pprPanic "vectExpr" (ppr $ deAnnotate e)
+
+vectExpr lc (fvs, AnnLam bndr body)
+ = do
+ tyvars <- localTyVars
+ info <- mkCEnvInfo fvs bndr body
+ (poly_vfn, poly_lfn) <- mkClosureFns info tyvars bndr body
+
+ vfn_var <- hoistExpr FSLIT("vfn") poly_vfn
+ lfn_var <- hoistExpr FSLIT("lfn") poly_lfn
+
+ let (venv, lenv) = mkClosureEnvs info lc
+
+ let env_ty = cenv_vty info
+
+ pa_dict <- paDictOfType env_ty
+
+ arg_ty <- vectType (varType bndr)
+ res_ty <- vectType (exprType $ deAnnotate body)
+
+ -- FIXME: move the functions to the top level
+ mono_vfn <- polyApply (Var vfn_var) (mkTyVarTys tyvars)
+ mono_lfn <- polyApply (Var lfn_var) (mkTyVarTys tyvars)
+
+ mk_clo <- builtin mkClosureVar
+ mk_cloP <- builtin mkClosurePVar
+
+ let vclo = Var mk_clo `mkTyApps` [arg_ty, res_ty, env_ty]
+ `mkApps` [pa_dict, mono_vfn, mono_lfn, venv]
+
+ lclo = Var mk_cloP `mkTyApps` [arg_ty, res_ty, env_ty]
+ `mkApps` [pa_dict, mono_vfn, mono_lfn, lenv]
+
+ return (vclo, lclo)
+
+data CEnvInfo = CEnvInfo {
+ cenv_vars :: [Var]
+ , cenv_values :: [(CoreExpr, CoreExpr)]
+ , cenv_vty :: Type
+ , cenv_lty :: Type
+ , cenv_repr_tycon :: TyCon
+ , cenv_repr_tyargs :: [Type]
+ , cenv_repr_datacon :: DataCon
+ }
+
+mkCEnvInfo :: VarSet -> Var -> CoreExprWithFVs -> VM CEnvInfo
+mkCEnvInfo fvs arg body