Refactoring

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])
 

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)]