2 module Vectorise.Type.Type
9 import Vectorise.Builtins
20 -- | Vectorise a type constructor.
21 vectTyCon :: TyCon -> VM TyCon
23 | isFunTyCon tc = builtin closureTyCon
24 | isBoxedTupleTyCon tc = return tc
25 | isUnLiftedTyCon tc = return tc
27 = maybeCantVectoriseM "Tycon not vectorised: " (ppr tc)
31 -- | Produce the vectorised and lifted versions of a type.
32 vectAndLiftType :: Type -> VM (Type, Type)
33 vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
36 mdicts <- mapM paDictArgType tyvars
37 let dicts = [dict | Just dict <- mdicts]
38 vmono_ty <- vectType mono_ty
39 lmono_ty <- mkPDataType vmono_ty
40 return (abstractType tyvars dicts vmono_ty,
41 abstractType tyvars dicts lmono_ty)
43 (tyvars, mono_ty) = splitForAllTys ty
46 -- | Vectorise a type.
47 vectType :: Type -> VM Type
49 | Just ty' <- coreView ty
52 vectType (TyVarTy tv) = return $ TyVarTy tv
53 vectType (AppTy ty1 ty2) = liftM2 AppTy (vectType ty1) (vectType ty2)
54 vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)
55 vectType (FunTy ty1 ty2) = liftM2 TyConApp (builtin closureTyCon)
56 (mapM vectAndBoxType [ty1,ty2])
58 -- For each quantified var we need to add a PA dictionary out the front of the type.
59 -- So forall a. C a => a -> a
60 -- turns into forall a. Cv a => PA a => a :-> a
61 vectType ty@(ForAllTy _ _)
63 -- split the type into the quantified vars, its dictionaries and the body.
64 let (tyvars, tyBody) = splitForAllTys ty
65 let (tyArgs, tyResult) = splitFunTys tyBody
67 let (tyArgs_dict, tyArgs_regular)
68 = partition isDictType tyArgs
70 -- vectorise the body.
71 let tyBody' = mkFunTys tyArgs_regular tyResult
72 tyBody'' <- vectType tyBody'
74 -- vectorise the dictionary parameters.
75 dictsVect <- mapM vectType tyArgs_dict
77 -- make a PA dictionary for each of the type variables.
78 dictsPA <- liftM catMaybes $ mapM paDictArgType tyvars
80 -- pack it all back together.
81 return $ abstractType tyvars (dictsVect ++ dictsPA) tyBody''
83 vectType ty = cantVectorise "Can't vectorise type" (ppr ty)
86 -- | Add quantified vars and dictionary parameters to the front of a type.
87 abstractType :: [TyVar] -> [Type] -> Type -> Type
88 abstractType tyvars dicts = mkForAllTys tyvars . mkFunTys dicts
91 -- | Check if some type is a type class dictionary.
92 isDictType :: Type -> Bool
94 = case splitTyConApp_maybe ty of
95 Just (tyCon, _) -> isClassTyCon tyCon
99 -- | Create the boxed version of a vectorised type.
100 vectAndBoxType :: Type -> VM Type
101 vectAndBoxType ty = vectType ty >>= boxType
104 -- | Create the boxed version of a type.
105 boxType :: Type -> VM Type
107 | Just (tycon, []) <- splitTyConApp_maybe ty
108 , isUnLiftedTyCon tycon
110 r <- lookupBoxedTyCon tycon
112 Just tycon' -> return $ mkTyConApp tycon' []
115 | otherwise = return ty