- lc_bndr <- newLocalVar FSLIT("lc") intPrimTy
- (bndrs, (vbody, lbody))
- <- vectBndrsIn (arg : cenv_vars info)
- (vectExpr lc_bndr body)
- let (varg : vbndrs, larg : lbndrs) = unzip bndrs
-
- 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
- len <- lengthPA (Var lbndr)
- return . Let (NonRec lbndr lenv)
- $ Case len
- 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 :: Var -> CoreExprWithFVs -> [Type] -> VM (CoreExpr, CoreExpr)
-vectTyAppExpr lc (_, AnnVar v) tys = vectPolyVar lc v tys
-vectTyAppExpr lc e tys = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e)
+ 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)