From: Roman Leshchinskiy Date: Wed, 22 Aug 2007 02:32:30 +0000 (+0000) Subject: Refactoring X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=0ae3d313b01aa495586839f396ba8850379ec1fa Refactoring --- 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])