Mainly, rename LiteralTy to LitTy
[ghc.git] / compiler / vectorise / Vectorise / Type / Type.hs
1 -- Apply the vectorisation transformation to types. This is the \mathcal{L}_t scheme in HtM.
2
3 module Vectorise.Type.Type
4 ( vectTyCon
5 , vectAndLiftType
6 , vectType
7 )
8 where
9
10 import Vectorise.Utils
11 import Vectorise.Monad
12 import Vectorise.Builtins
13 import TcType
14 import Type
15 import TypeRep
16 import TyCon
17 import Outputable
18 import Control.Monad
19 import Control.Applicative
20 import Data.Maybe
21
22 -- | Vectorise a type constructor.
23 --
24 vectTyCon :: TyCon -> VM TyCon
25 vectTyCon tc
26 | isFunTyCon tc = builtin closureTyCon
27 | isBoxedTupleTyCon tc = return tc
28 | isUnLiftedTyCon tc = return tc
29 | otherwise
30 = maybeCantVectoriseM "Tycon not vectorised: " (ppr tc)
31 $ lookupTyCon tc
32
33 -- |Produce the vectorised and lifted versions of a type.
34 --
35 -- NB: Here we are limited to properly handle predicates at the toplevel only. Anything embedded
36 -- in what is called the 'body_ty' below will end up as an argument to the type family 'PData'.
37 --
38 vectAndLiftType :: Type -> VM (Type, Type)
39 vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
40 vectAndLiftType ty
41 = do { padicts <- liftM catMaybes $ mapM paDictArgType tyvars
42 ; vmono_ty <- vectType mono_ty
43 ; lmono_ty <- mkPDataType vmono_ty
44 ; return (abstractType tyvars (padicts ++ theta) vmono_ty,
45 abstractType tyvars (padicts ++ theta) lmono_ty)
46 }
47 where
48 (tyvars, phiTy) = splitForAllTys ty
49 (theta, mono_ty) = tcSplitPhiTy phiTy
50
51 -- |Vectorise a type.
52 --
53 -- For each quantified var we need to add a PA dictionary out the front of the type.
54 -- So forall a. C a => a -> a
55 -- turns into forall a. PA a => Cv a => a :-> a
56 --
57 vectType :: Type -> VM Type
58 vectType ty
59 | Just ty' <- coreView ty
60 = vectType ty'
61 vectType (TyVarTy tv) = return $ TyVarTy tv
62 vectType (LitTy l) = return $ LitTy l
63 vectType (AppTy ty1 ty2) = AppTy <$> vectType ty1 <*> vectType ty2
64 vectType (TyConApp tc tys) = TyConApp <$> vectTyCon tc <*> mapM vectType tys
65 vectType (FunTy ty1 ty2)
66 | isPredTy ty1
67 = FunTy <$> vectType ty1 <*> vectType ty2 -- don't build a closure for dictionary abstraction
68 | otherwise
69 = TyConApp <$> builtin closureTyCon <*> mapM vectType [ty1, ty2]
70 vectType ty@(ForAllTy _ _)
71 = do { -- strip off consecutive foralls
72 ; let (tyvars, tyBody) = splitForAllTys ty
73
74 -- vectorise the body
75 ; vtyBody <- vectType tyBody
76
77 -- make a PA dictionary for each of the type variables
78 ; dictsPA <- liftM catMaybes $ mapM paDictArgType tyvars
79
80 -- add the PA dictionaries after the foralls
81 ; return $ abstractType tyvars dictsPA vtyBody
82 }
83
84 -- |Add quantified vars and dictionary parameters to the front of a type.
85 --
86 abstractType :: [TyVar] -> [Type] -> Type -> Type
87 abstractType tyvars dicts = mkForAllTys tyvars . mkFunTys dicts