painstInstance = inst
, painstVectTyCon = vect_tc
, painstArrTyCon = arr_tc })
- = localV . abstractOverTyVars (tyConTyVars arr_tc) $ \abstract ->
+ = polyAbstract (tyConTyVars arr_tc) $ \abstract ->
do
shape <- tyConShape vect_tc
meth_binds <- mapM (mk_method shape) paMethods
mkPADictType, mkPArrayType,
paDictArgType, paDictOfType,
paMethod, lengthPA, replicatePA, emptyPA,
- abstractOverTyVars, applyToTypes,
+ polyAbstract, polyApply,
lookupPArrayFamInst,
hoistExpr, takeHoisted
) where
emptyPA :: Type -> VM CoreExpr
emptyPA = paMethod emptyPAVar
-abstractOverTyVars :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
-abstractOverTyVars tvs p
- = do
+polyAbstract :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
+polyAbstract tvs p
+ = localV
+ $ do
mdicts <- mapM mk_dict_var tvs
zipWithM_ (\tv -> maybe (defLocalTyVar tv) (defLocalTyVarWithPA tv . Var)) tvs mdicts
p (mk_lams mdicts)
mk_lams mdicts = mkLams (tvs ++ [dict | Just dict <- mdicts])
-applyToTypes :: CoreExpr -> [Type] -> VM CoreExpr
-applyToTypes expr tys
+polyApply :: CoreExpr -> [Type] -> VM CoreExpr
+polyApply expr tys
= do
dicts <- mapM paDictOfType tys
return $ expr `mkTyApps` tys `mkApps` dicts
lexpr <- replicatePA vexpr lc
return (vexpr, lexpr)
where
- mk_app e = applyToTypes e =<< mapM vectType tys
+ mk_app e = polyApply e =<< mapM vectType tys
vectPolyExpr :: CoreExpr -> CoreExprWithFVs -> VM (CoreExpr, CoreExpr)
vectPolyExpr lc expr
- = localV
- . abstractOverTyVars tvs $ \mk_lams ->
+ = polyAbstract tvs $ \mk_lams ->
-- FIXME: shadowing (tvs in lc)
do
(vmono, lmono) <- vectExpr lc mono
res_ty <- vectType (exprType $ deAnnotate body)
-- FIXME: move the functions to the top level
- mono_vfn <- applyToTypes (Var vfn_var) (mkTyVarTys tyvars)
- mono_lfn <- applyToTypes (Var lfn_var) (mkTyVarTys tyvars)
+ mono_vfn <- polyApply (Var vfn_var) (mkTyVarTys tyvars)
+ mono_lfn <- polyApply (Var lfn_var) (mkTyVarTys tyvars)
mk_clo <- builtin mkClosureVar
mk_cloP <- builtin mkClosurePVar
-> VM (CoreExpr, CoreExpr)
mkClosureFns info tyvars arg body
= closedV
- . abstractOverTyVars tyvars
+ . polyAbstract tyvars
$ \mk_tlams ->
do
(vfn, lfn) <- mkClosureMonoFns info arg body