Commit a0a97c2b authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au

Refactoring

parent 2924c4bc
......@@ -2,7 +2,7 @@ module VectUtils (
collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg,
splitClosureTy,
mkPADictType, mkPArrayType,
paDictArgType, paDictOfType,
paDictArgType, paDictOfType, paMethod,
lookupPArrayFamInst,
hoistExpr, takeHoisted
) where
......@@ -108,6 +108,13 @@ paDFunApply dfun tys
dicts <- mapM paDictOfType tys
return $ mkApps (mkTyApps dfun tys) dicts
paMethod :: (Builtins -> Var) -> Type -> VM CoreExpr
paMethod method ty
= do
fn <- builtin method
dict <- paDictOfType ty
return $ mkApps (Var fn) [Type ty, dict]
lookupPArrayFamInst :: Type -> VM (TyCon, [Type])
lookupPArrayFamInst ty = builtin parrayTyCon >>= (`lookupFamInst` [ty])
......
......@@ -142,13 +142,8 @@ vectBndrsIn vs p
-- Expressions
replicateP :: CoreExpr -> CoreExpr -> VM CoreExpr
replicateP expr len
= do
dict <- paDictOfType ty
rep <- builtin replicatePAVar
return $ mkApps (Var rep) [Type ty, dict, expr, len]
where
ty = exprType expr
replicateP expr len = liftM (`mkApps` [expr, len])
(paMethod replicatePAVar (exprType expr))
capply :: (CoreExpr, CoreExpr) -> (CoreExpr, CoreExpr) -> VM (CoreExpr, CoreExpr)
capply (vfn, lfn) (varg, larg)
......@@ -410,10 +405,9 @@ mkClosureMonoFns info arg body
bind_lenv lenv lbody lc_bndr [lbndr]
= do
lengthPA <- builtin lengthPAVar
pa_dict <- paDictOfType vty
lengthPA <- paMethod lengthPAVar vty
return . Let (NonRec lbndr lenv)
$ Case (mkApps (Var lengthPA) [Type vty, pa_dict, (Var lbndr)])
$ Case (App lengthPA (Var lbndr))
lc_bndr
(exprType lbody)
[(DEFAULT, [], lbody)]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment