Move some vectorisation utility functions
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Tue, 10 Jul 2007 14:09:34 +0000 (14:09 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Tue, 10 Jul 2007 14:09:34 +0000 (14:09 +0000)
compiler/vectorise/VectUtils.hs
compiler/vectorise/Vectorise.hs

index acf19d4..2a3b3fa 100644 (file)
@@ -1,4 +1,6 @@
 module VectUtils (
+  splitClosureTy,
+  mkPADictType, mkPArrayType,
   paDictArgType, paDictOfType
 ) where
 
@@ -9,10 +11,37 @@ import VectMonad
 import CoreSyn
 import Type
 import TypeRep
+import TyCon
 import Var
+import PrelNames
 
 import Outputable
 
+import Control.Monad         ( liftM )
+
+isClosureTyCon :: TyCon -> Bool
+isClosureTyCon tc = tyConUnique tc == closureTyConKey
+
+splitClosureTy :: Type -> (Type, Type)
+splitClosureTy ty
+  | Just (tc, [arg_ty, res_ty]) <- splitTyConApp_maybe ty
+  , isClosureTyCon tc
+  = (arg_ty, res_ty)
+
+  | otherwise = pprPanic "splitClosureTy" (ppr ty)
+
+mkPADictType :: Type -> VM Type
+mkPADictType ty
+  = do
+      tc <- builtin paDictTyCon
+      return $ TyConApp tc [ty]
+
+mkPArrayType :: Type -> VM Type
+mkPArrayType ty
+  = do
+      tc <- builtin parrayTyCon
+      return $ TyConApp tc [ty]
+
 paDictArgType :: TyVar -> VM (Maybe Type)
 paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
   where
@@ -29,9 +58,7 @@ paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
 
     go ty k
       | isLiftedTypeKind k
-      = do
-          tc <- builtin paDictTyCon
-          return . Just $ TyConApp tc [ty]
+      = liftM Just (mkPADictType ty)
 
     go ty k = return Nothing
 
index c845ea3..6f9db0a 100644 (file)
@@ -54,7 +54,7 @@ vectBndr :: Var -> VM (Var, Var)
 vectBndr v
   = do
       vty <- vectType (idType v)
-      lty <- mkPArrayTy vty
+      lty <- mkPArrayType vty
       let vv = v `Id.setIdType` vty
           lv = v `Id.setIdType` lty
       updLEnv (mapTo vv lv)
@@ -198,19 +198,3 @@ vectType (ForAllTy tv ty)
 
 vectType ty = pprPanic "vectType:" (ppr ty)
 
-isClosureTyCon :: TyCon -> Bool
-isClosureTyCon tc = tyConUnique tc == closureTyConKey
-
-splitClosureTy :: Type -> (Type, Type)
-splitClosureTy ty
-  | Just (tc, [arg_ty, res_ty]) <- splitTyConApp_maybe ty
-  , isClosureTyCon tc
-  = (arg_ty, res_ty)
-
-  | otherwise = pprPanic "splitClosureTy" (ppr ty)
-
-mkPArrayTy :: Type -> VM Type
-mkPArrayTy ty = do
-                  tc <- builtin parrayTyCon
-                  return $ TyConApp tc [ty]
-