2 module Vectorise.Utils.Base (
7 mkDataConTag, dataConTagZ,
13 mkPArrayType, splitPrimTyCon,
23 import Vectorise.Monad
25 import Vectorise.Builtins
39 -- Simple Types ---------------------------------------------------------------
41 voidType = mkBuiltinTyConApp voidTyCon []
44 -- Name Generation ------------------------------------------------------------
45 newLocalVVar :: FastString -> Type -> VM VVar
48 lty <- mkPDataType vty
49 vv <- newLocalVar fs vty
50 lv <- newLocalVar fs lty
54 -- Constructors ---------------------------------------------------------------
55 mkDataConTagLit :: DataCon -> Literal
56 mkDataConTagLit = mkMachInt . toInteger . dataConTagZ
59 mkDataConTag :: DataCon -> CoreExpr
60 mkDataConTag = mkIntLitInt . dataConTagZ
63 dataConTagZ :: DataCon -> Int
64 dataConTagZ con = dataConTag con - fIRST_TAG
67 mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
68 mkBuiltinTyConApp get_tc tys
71 return $ mkTyConApp tc tys
74 mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type
75 mkBuiltinTyConApps get_tc tys ty
78 return $ foldr (mk tc) ty tys
80 mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
83 mkWrapType :: Type -> VM Type
84 mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
87 mkClosureTypes :: [Type] -> Type -> VM Type
88 mkClosureTypes = mkBuiltinTyConApps closureTyCon
91 mkPReprType :: Type -> VM Type
92 mkPReprType ty = mkBuiltinTyConApp preprTyCon [ty]
96 mkPArrayType :: Type -> VM Type
98 | Just tycon <- splitPrimTyCon ty
100 r <- lookupPrimPArray tycon
102 Just arr -> return $ mkTyConApp arr []
103 Nothing -> cantVectorise "Primitive tycon not vectorised" (ppr tycon)
105 mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty]
107 splitPrimTyCon :: Type -> Maybe TyCon
109 | Just (tycon, []) <- splitTyConApp_maybe ty
113 | otherwise = Nothing
117 mkPArray :: Type -> CoreExpr -> CoreExpr -> VM CoreExpr
118 mkPArray ty len dat = do
119 tc <- builtin parrayTyCon
120 let [dc] = tyConDataCons tc
121 return $ mkConApp dc [Type ty, len, dat]
124 mkPDataType :: Type -> VM Type
125 mkPDataType ty = mkBuiltinTyConApp pdataTyCon [ty]
128 mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
132 return $ mkTyConApp tc []
135 mkVScrut :: VExpr -> VM (CoreExpr, CoreExpr, TyCon, [Type])
138 (tc, arg_tys) <- pdataReprTyCon ty
139 return (ve, unwrapFamInstScrut tc arg_tys le, tc, arg_tys)
143 pdataReprTyCon :: Type -> VM (TyCon, [Type])
144 pdataReprTyCon ty = builtin pdataTyCon >>= (`lookupFamInst` [ty])
147 pdataReprDataCon :: Type -> VM (DataCon, [Type])
150 (tc, arg_tys) <- pdataReprTyCon ty
151 let [dc] = tyConDataCons tc