2 module Vectorise.Utils.Base (
7 mkDataConTag, dataConTagZ,
13 mkPArrayType, splitPrimTyCon,
25 import Vectorise.Monad
27 import Vectorise.Builtins
40 import Control.Monad (liftM)
43 -- Simple Types ---------------------------------------------------------------
45 voidType = mkBuiltinTyConApp voidTyCon []
48 -- Name Generation ------------------------------------------------------------
49 newLocalVVar :: FastString -> Type -> VM VVar
52 lty <- mkPDataType vty
53 vv <- newLocalVar fs vty
54 lv <- newLocalVar fs lty
58 -- Constructors ---------------------------------------------------------------
59 mkDataConTagLit :: DataCon -> Literal
60 mkDataConTagLit = mkMachInt . toInteger . dataConTagZ
63 mkDataConTag :: DataCon -> CoreExpr
64 mkDataConTag = mkIntLitInt . dataConTagZ
67 dataConTagZ :: DataCon -> Int
68 dataConTagZ con = dataConTag con - fIRST_TAG
71 mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
72 mkBuiltinTyConApp get_tc tys
75 return $ mkTyConApp tc tys
78 mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type
79 mkBuiltinTyConApps get_tc tys ty
82 return $ foldr (mk tc) ty tys
84 mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
87 mkWrapType :: Type -> VM Type
88 mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]
91 mkClosureTypes :: [Type] -> Type -> VM Type
92 mkClosureTypes = mkBuiltinTyConApps closureTyCon
95 mkPReprType :: Type -> VM Type
96 mkPReprType ty = mkBuiltinTyConApp preprTyCon [ty]
100 mkPArrayType :: Type -> VM Type
102 | Just tycon <- splitPrimTyCon ty
104 r <- lookupPrimPArray tycon
106 Just arr -> return $ mkTyConApp arr []
107 Nothing -> cantVectorise "Primitive tycon not vectorised" (ppr tycon)
109 mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty]
111 splitPrimTyCon :: Type -> Maybe TyCon
113 | Just (tycon, []) <- splitTyConApp_maybe ty
117 | otherwise = Nothing
121 mkPArray :: Type -> CoreExpr -> CoreExpr -> VM CoreExpr
122 mkPArray ty len dat = do
123 tc <- builtin parrayTyCon
124 let [dc] = tyConDataCons tc
125 return $ mkConApp dc [Type ty, len, dat]
128 mkPDataType :: Type -> VM Type
129 mkPDataType ty = mkBuiltinTyConApp pdataTyCon [ty]
132 mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
136 return $ mkTyConApp tc []
139 mkVScrut :: VExpr -> VM (CoreExpr, CoreExpr, TyCon, [Type])
142 (tc, arg_tys) <- pdataReprTyCon ty
143 return (ve, unwrapFamInstScrut tc arg_tys le, tc, arg_tys)
147 preprSynTyCon :: Type -> VM (TyCon, [Type])
148 preprSynTyCon ty = builtin preprTyCon >>= (`lookupFamInst` [ty])
150 pdataReprTyCon :: Type -> VM (TyCon, [Type])
151 pdataReprTyCon ty = builtin pdataTyCon >>= (`lookupFamInst` [ty])
154 pdataReprDataCon :: Type -> VM (DataCon, [Type])
157 (tc, arg_tys) <- pdataReprTyCon ty
158 let [dc] = tyConDataCons tc
161 prDFunOfTyCon :: TyCon -> VM CoreExpr
164 . maybeCantVectoriseM "No PR dictionary for tycon" (ppr tycon)
165 $ lookupTyConPR tycon