From a0a97c2bc86a334185b8c45ac377e2c1ff65f608 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Wed, 25 Jul 2007 02:24:41 +0000 Subject: [PATCH] Refactoring --- compiler/vectorise/VectUtils.hs | 9 ++++++++- compiler/vectorise/Vectorise.hs | 14 ++++---------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index 199ef68..4982fcc 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -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]) diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index 64d46fc..81c9c55 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -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)] -- 1.7.10.4