Commit 5e979164 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Move some vectorisation utility functions

parent 398fb620
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
......
......@@ -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]
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment