From 0ae3d313b01aa495586839f396ba8850379ec1fa Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Wed, 22 Aug 2007 02:32:30 +0000 Subject: [PATCH] Refactoring --- compiler/vectorise/VectUtils.hs | 44 ++++++++++++++++++++++++--------------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs index dbdc38f..eee2734 100644 --- a/compiler/vectorise/VectUtils.hs +++ b/compiler/vectorise/VectUtils.hs @@ -84,31 +84,41 @@ splitPArrayTy ty | otherwise = pprPanic "splitPArrayTy" (ppr ty) -mkClosureType :: Type -> Type -> VM Type -mkClosureType arg_ty res_ty +mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type +mkBuiltinTyConApp get_tc tys = do - tc <- builtin closureTyCon - return $ mkTyConApp tc [arg_ty, res_ty] + tc <- builtin get_tc + return $ mkTyConApp tc tys -mkClosureTypes :: [Type] -> Type -> VM Type -mkClosureTypes arg_tys res_ty +mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type +mkBuiltinTyConApps get_tc tys ty = do - tc <- builtin closureTyCon - return $ foldr (mk tc) res_ty arg_tys + tc <- builtin get_tc + return $ foldr (mk tc) ty tys where - mk tc arg_ty res_ty = mkTyConApp tc [arg_ty, res_ty] + mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2] -mkPADictType :: Type -> VM Type -mkPADictType ty +mkBuiltinTyConApps1 :: (Builtins -> TyCon) -> [Type] -> VM Type +mkBuiltinTyConApps1 get_tc tys = do - tc <- builtin paTyCon - return $ TyConApp tc [ty] + tc <- builtin get_tc + case tys of + [] -> pprPanic "mkBuiltinTyConApps1" (ppr tc) + _ -> return $ foldr1 (mk tc) tys + where + mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2] + +mkClosureType :: Type -> Type -> VM Type +mkClosureType arg_ty res_ty = mkBuiltinTyConApp closureTyCon [arg_ty, res_ty] + +mkClosureTypes :: [Type] -> Type -> VM Type +mkClosureTypes = mkBuiltinTyConApps closureTyCon + +mkPADictType :: Type -> VM Type +mkPADictType ty = mkBuiltinTyConApp paTyCon [ty] mkPArrayType :: Type -> VM Type -mkPArrayType ty - = do - tc <- builtin parrayTyCon - return $ TyConApp tc [ty] +mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty] parrayReprTyCon :: Type -> VM (TyCon, [Type]) parrayReprTyCon ty = builtin parrayTyCon >>= (`lookupFamInst` [ty]) -- 1.7.10.4