X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fvectorise%2FVectUtils.hs;h=8e95b809656b59e0dc58a4f8413481b24a85517d;hb=742db8bde59c1175a50e5045332f05ec22d12e80;hp=eee2734929a579186604a9f127525957e0cdcb75;hpb=0ae3d313b01aa495586839f396ba8850379ec1fa;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index eee2734..8e95b80 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -3,6 +3,7 @@ module VectUtils ( collectAnnValBinders, mkDataConTag, splitClosureTy, + mkPlusType, mkPlusTypes, mkCrossType, mkCrossTypes, mkEmbedType, mkPADictType, mkPArrayType, parrayReprTyCon, parrayReprDataCon, mkVScrut, paDictArgType, paDictOfType, paDFunType, @@ -98,8 +99,9 @@ mkBuiltinTyConApps get_tc tys ty where mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2] -mkBuiltinTyConApps1 :: (Builtins -> TyCon) -> [Type] -> VM Type -mkBuiltinTyConApps1 get_tc tys +mkBuiltinTyConApps1 :: (Builtins -> TyCon) -> Type -> [Type] -> VM Type +mkBuiltinTyConApps1 get_tc dft [] = return dft +mkBuiltinTyConApps1 get_tc dft tys = do tc <- builtin get_tc case tys of @@ -108,6 +110,21 @@ mkBuiltinTyConApps1 get_tc tys where mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2] +mkPlusType :: Type -> Type -> VM Type +mkPlusType ty1 ty2 = mkBuiltinTyConApp plusTyCon [ty1, ty2] + +mkPlusTypes :: Type -> [Type] -> VM Type +mkPlusTypes = mkBuiltinTyConApps1 plusTyCon + +mkCrossType :: Type -> Type -> VM Type +mkCrossType ty1 ty2 = mkBuiltinTyConApp crossTyCon [ty1, ty2] + +mkCrossTypes :: Type -> [Type] -> VM Type +mkCrossTypes = mkBuiltinTyConApps1 crossTyCon + +mkEmbedType :: Type -> VM Type +mkEmbedType ty = mkBuiltinTyConApp embedTyCon [ty] + mkClosureType :: Type -> Type -> VM Type mkClosureType arg_ty res_ty = mkBuiltinTyConApp closureTyCon [arg_ty, res_ty]