From 176b587c4df6f54d0315b0dd9e7337b9085910ba Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Wed, 25 Jul 2007 02:30:17 +0000 Subject: [PATCH] More refactoring --- compiler/vectorise/VectUtils.hs | 10 +++++++++- compiler/vectorise/Vectorise.hs | 14 +++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 4982fcc..24a12ea 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -2,7 +2,8 @@ module VectUtils ( collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg, splitClosureTy, mkPADictType, mkPArrayType, - paDictArgType, paDictOfType, paMethod, + paDictArgType, paDictOfType, + paMethod, lengthPA, replicatePA, lookupPArrayFamInst, hoistExpr, takeHoisted ) where @@ -115,6 +116,13 @@ paMethod method ty dict <- paDictOfType ty return $ mkApps (Var fn) [Type ty, dict] +lengthPA :: CoreExpr -> VM CoreExpr +lengthPA x = liftM (`App` x) (paMethod lengthPAVar (exprType x)) + +replicatePA :: CoreExpr -> CoreExpr -> VM CoreExpr +replicatePA len x = liftM (`mkApps` [len,x]) + (paMethod replicatePAVar (exprType x)) + lookupPArrayFamInst :: Type -> VM (TyCon, [Type]) lookupPArrayFamInst ty = builtin parrayTyCon >>= (`lookupFamInst` [ty]) diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 81c9c55..0d9a8e1 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -141,10 +141,6 @@ vectBndrsIn vs p -- ---------------------------------------------------------------------------- -- Expressions -replicateP :: CoreExpr -> CoreExpr -> VM CoreExpr -replicateP expr len = liftM (`mkApps` [expr, len]) - (paMethod replicatePAVar (exprType expr)) - capply :: (CoreExpr, CoreExpr) -> (CoreExpr, CoreExpr) -> VM (CoreExpr, CoreExpr) capply (vfn, lfn) (varg, larg) = do @@ -163,7 +159,7 @@ vectVar lc v case r of Local es -> return es Global vexpr -> do - lexpr <- replicateP vexpr lc + lexpr <- replicatePA vexpr lc return (vexpr, lexpr) vectPolyVar :: CoreExpr -> Var -> [Type] -> VM (CoreExpr, CoreExpr) @@ -174,7 +170,7 @@ vectPolyVar lc v tys Local (vexpr, lexpr) -> liftM2 (,) (mk_app vexpr) (mk_app lexpr) Global poly -> do vexpr <- mk_app poly - lexpr <- replicateP vexpr lc + lexpr <- replicatePA vexpr lc return (vexpr, lexpr) where mk_app e = applyToTypes e =<< mapM vectType tys @@ -222,7 +218,7 @@ vectExpr lc (_, AnnVar v) = vectVar lc v vectExpr lc (_, AnnLit lit) = do let vexpr = Lit lit - lexpr <- replicateP vexpr lc + lexpr <- replicatePA vexpr lc return (vexpr, lexpr) vectExpr lc (_, AnnNote note expr) @@ -405,9 +401,9 @@ mkClosureMonoFns info arg body bind_lenv lenv lbody lc_bndr [lbndr] = do - lengthPA <- paMethod lengthPAVar vty + len <- lengthPA (Var lbndr) return . Let (NonRec lbndr lenv) - $ Case (App lengthPA (Var lbndr)) + $ Case len lc_bndr (exprType lbody) [(DEFAULT, [], lbody)] -- 1.7.10.4