From: Roman Leshchinskiy Date: Fri, 31 Aug 2007 01:26:38 +0000 (+0000) Subject: Refactoring X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=17bf0a5763b2a94ee88f8bebfe61c84f20cc9d05 Refactoring --- diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs index ca5f0c8..6e10dee 100644 --- a/compiler/vectorise/VectType.hs +++ b/compiler/vectorise/VectType.hs @@ -231,17 +231,23 @@ data Repr = ProdRepr { , void_bottom :: CoreExpr } -mkVoid :: VM Repr -mkVoid = do - tycon <- builtin voidTyCon - var <- builtin voidVar - return $ VoidRepr { - void_tycon = tycon - , void_bottom = Var var - } - -mkProduct :: [Type] -> VM Repr -mkProduct tys +voidRepr :: VM Repr +voidRepr + = do + tycon <- builtin voidTyCon + var <- builtin voidVar + return $ VoidRepr { + void_tycon = tycon + , void_bottom = Var var + } + +unboxedProductRepr :: [Type] -> VM Repr +unboxedProductRepr [] = voidRepr +unboxedProductRepr [ty] = return $ IdRepr ty +unboxedProductRepr tys = boxedProductRepr tys + +boxedProductRepr :: [Type] -> VM Repr +boxedProductRepr tys = do tycon <- builtin (prodTyCon arity) let [data_con] = tyConDataCons tycon @@ -259,14 +265,10 @@ mkProduct tys where arity = length tys -mkSubProduct :: [Type] -> VM Repr -mkSubProduct [] = mkVoid -mkSubProduct [ty] = return $ IdRepr ty -mkSubProduct tys = mkProduct tys - -mkSum :: [Repr] -> VM Repr -mkSum [repr] = return repr -mkSum reprs +sumRepr :: [Repr] -> VM Repr +sumRepr [] = voidRepr +sumRepr [repr] = boxRepr repr +sumRepr reprs = do tycon <- builtin (sumTyCon arity) (arr_tycon, _) <- parrayReprTyCon @@ -284,6 +286,11 @@ mkSum reprs where arity = length reprs +boxRepr :: Repr -> VM Repr +boxRepr (VoidRepr {}) = boxedProductRepr [] +boxRepr (IdRepr ty) = boxedProductRepr [ty] +boxRepr repr = return repr + reprType :: Repr -> Type reprType (ProdRepr { prod_tycon = tycon, prod_components = tys }) = mkTyConApp tycon tys @@ -347,8 +354,7 @@ arrReprVars repr mkRepr :: TyCon -> VM Repr mkRepr vect_tc - | [tys] <- rep_tys = mkProduct tys - | otherwise = mkSum =<< mapM mkSubProduct rep_tys + = sumRepr =<< mapM unboxedProductRepr rep_tys where rep_tys = map dataConRepArgTys $ tyConDataCons vect_tc