module VectUtils (
+ splitClosureTy,
+ mkPADictType, mkPArrayType,
paDictArgType, paDictOfType
) where
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
go ty k
| isLiftedTypeKind k
- = do
- tc <- builtin paDictTyCon
- return . Just $ TyConApp tc [ty]
+ = liftM Just (mkPADictType ty)
go ty k = return Nothing
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)
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]
-