From 5e979164079ae89ca01483131149b8727dd82686 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Tue, 10 Jul 2007 14:09:34 +0000 Subject: [PATCH] Move some vectorisation utility functions --- compiler/vectorise/VectUtils.hs | 33 ++++++++++++++++++++++++++++++--- compiler/vectorise/Vectorise.hs | 18 +----------------- 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index acf19d4..2a3b3fa 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -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 diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index c845ea3..6f9db0a 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -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] - -- 1.7.10.4