From 76fb33900748c86d97aa528bae91cd1844aed97d Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Wed, 25 Jul 2007 03:48:13 +0000
Subject: [PATCH] Move code

---
 compiler/vectorise/VectUtils.hs |   24 +++++++++++++++++++++++-
 compiler/vectorise/Vectorise.hs |   23 +----------------------
 2 files changed, 24 insertions(+), 23 deletions(-)

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index 0df1672..0d200a8 100644
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -4,6 +4,7 @@ module VectUtils (
   mkPADictType, mkPArrayType,
   paDictArgType, paDictOfType,
   paMethod, lengthPA, replicatePA, emptyPA,
+  abstractOverTyVars, applyToTypes,
   lookupPArrayFamInst,
   hoistExpr, takeHoisted
 ) where
@@ -23,7 +24,7 @@ import PrelNames
 import Outputable
 import FastString
 
-import Control.Monad         ( liftM )
+import Control.Monad         ( liftM, zipWithM_ )
 
 collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
 collectAnnTypeArgs expr = go expr []
@@ -126,6 +127,27 @@ replicatePA len x = liftM (`mkApps` [len,x])
 emptyPA :: Type -> VM CoreExpr
 emptyPA = paMethod emptyPAVar
 
+abstractOverTyVars :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
+abstractOverTyVars tvs p
+  = do
+      mdicts <- mapM mk_dict_var tvs
+      zipWithM_ (\tv -> maybe (defLocalTyVar tv) (defLocalTyVarWithPA tv . Var)) tvs mdicts
+      p (mk_lams mdicts)
+  where
+    mk_dict_var tv = do
+                       r <- paDictArgType tv
+                       case r of
+                         Just ty -> liftM Just (newLocalVar FSLIT("dPA") ty)
+                         Nothing -> return Nothing
+
+    mk_lams mdicts = mkLams (tvs ++ [dict | Just dict <- mdicts])
+
+applyToTypes :: CoreExpr -> [Type] -> VM CoreExpr
+applyToTypes expr tys
+  = do
+      dicts <- mapM paDictOfType tys
+      return $ expr `mkTyApps` tys `mkApps` dicts
+
 lookupPArrayFamInst :: Type -> VM (TyCon, [Type])
 lookupPArrayFamInst ty = builtin parrayTyCon >>= (`lookupFamInst` [ty])
 
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 0d9a8e1..a35c806 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -40,7 +40,7 @@ import BasicTypes           ( Boxity(..) )
 
 import Outputable
 import FastString
-import Control.Monad        ( liftM, liftM2, mapAndUnzipM, zipWithM_ )
+import Control.Monad        ( liftM, liftM2, mapAndUnzipM )
 
 vectorise :: HscEnv -> UniqSupply -> RuleBase -> ModGuts
           -> IO (SimplCount, ModGuts)
@@ -175,27 +175,6 @@ vectPolyVar lc v tys
   where
     mk_app e = applyToTypes e =<< mapM vectType tys
 
-abstractOverTyVars :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
-abstractOverTyVars tvs p
-  = do
-      mdicts <- mapM mk_dict_var tvs
-      zipWithM_ (\tv -> maybe (defLocalTyVar tv) (defLocalTyVarWithPA tv . Var)) tvs mdicts
-      p (mk_lams mdicts)
-  where
-    mk_dict_var tv = do
-                       r <- paDictArgType tv
-                       case r of
-                         Just ty -> liftM Just (newLocalVar FSLIT("dPA") ty)
-                         Nothing -> return Nothing
-
-    mk_lams mdicts = mkLams (tvs ++ [dict | Just dict <- mdicts])
-
-applyToTypes :: CoreExpr -> [Type] -> VM CoreExpr
-applyToTypes expr tys
-  = do
-      dicts <- mapM paDictOfType tys
-      return $ expr `mkTyApps` tys `mkApps` dicts
-
 vectPolyExpr :: CoreExpr -> CoreExprWithFVs -> VM (CoreExpr, CoreExpr)
 vectPolyExpr lc expr
   = localV
-- 
1.7.10.4