2 -- | Representation of Algebraic Data Types.
3 module Vectorise.Type.Repr
16 import Vectorise.Monad
17 import Vectorise.Builtins
26 data CompRepr = Keep Type
27 CoreExpr -- PR dictionary for the type
30 data ProdRepr = EmptyProd
32 | Prod { repr_tup_tc :: TyCon -- representation tuple tycon
33 , repr_ptup_tc :: TyCon -- PData representation tycon
34 , repr_comp_tys :: [Type] -- representation types of
35 , repr_comps :: [CompRepr] -- components
37 data ConRepr = ConRepr DataCon ProdRepr
39 data SumRepr = EmptySum
41 | Sum { repr_sum_tc :: TyCon -- representation sum tycon
42 , repr_psum_tc :: TyCon -- PData representation tycon
43 , repr_sel_ty :: Type -- type of selector
44 , repr_con_tys :: [Type] -- representation types of
45 , repr_cons :: [ConRepr] -- components
48 tyConRepr :: TyCon -> VM SumRepr
49 tyConRepr tc = sum_repr (tyConDataCons tc)
51 sum_repr [] = return EmptySum
52 sum_repr [con] = liftM UnarySum (con_repr con)
54 rs <- mapM con_repr cons
55 sum_tc <- builtin (sumTyCon arity)
56 tys <- mapM conReprType rs
57 (psum_tc, _) <- pdataReprTyCon (mkTyConApp sum_tc tys)
58 sel_ty <- builtin (selTy arity)
59 return $ Sum { repr_sum_tc = sum_tc
60 , repr_psum_tc = psum_tc
61 , repr_sel_ty = sel_ty
68 con_repr con = liftM (ConRepr con) (prod_repr (dataConRepArgTys con))
70 prod_repr [] = return EmptyProd
71 prod_repr [ty] = liftM UnaryProd (comp_repr ty)
73 rs <- mapM comp_repr tys
74 tup_tc <- builtin (prodTyCon arity)
75 tys' <- mapM compReprType rs
76 (ptup_tc, _) <- pdataReprTyCon (mkTyConApp tup_tc tys')
77 return $ Prod { repr_tup_tc = tup_tc
78 , repr_ptup_tc = ptup_tc
79 , repr_comp_tys = tys'
85 comp_repr ty = liftM (Keep ty) (prDictOfType ty)
86 `orElseV` return (Wrap ty)
88 sumReprType :: SumRepr -> VM Type
89 sumReprType EmptySum = voidType
90 sumReprType (UnarySum r) = conReprType r
91 sumReprType (Sum { repr_sum_tc = sum_tc, repr_con_tys = tys })
92 = return $ mkTyConApp sum_tc tys
94 conReprType :: ConRepr -> VM Type
95 conReprType (ConRepr _ r) = prodReprType r
97 prodReprType :: ProdRepr -> VM Type
98 prodReprType EmptyProd = voidType
99 prodReprType (UnaryProd r) = compReprType r
100 prodReprType (Prod { repr_tup_tc = tup_tc, repr_comp_tys = tys })
101 = return $ mkTyConApp tup_tc tys
103 compReprType :: CompRepr -> VM Type
104 compReprType (Keep ty _) = return ty
105 compReprType (Wrap ty) = do
106 wrap_tc <- builtin wrapTyCon
107 return $ mkTyConApp wrap_tc [ty]
109 compOrigType :: CompRepr -> Type
110 compOrigType (Keep ty _) = ty
111 compOrigType (Wrap ty) = ty