X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectCore.hs;h=cdae4dd9968a17ce6054ede5096828d961402276;hb=5e31722536dab26e945a466f5eba1578b470a1b9;hp=1145dd2b399ddd42719c28f4dfe8bd26abfa53d5;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectCore.hs b/compiler/vectorise/VectCore.hs index 1145dd2..cdae4dd 100644 --- a/compiler/vectorise/VectCore.hs +++ b/compiler/vectorise/VectCore.hs @@ -1,30 +1,22 @@ -{-# OPTIONS_GHC -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings --- for details - module VectCore ( Vect, VVar, VExpr, VBind, vectorised, lifted, mapVect, + vVarType, + vNonRec, vRec, vVar, vType, vNote, vLet, vLams, vLamsWithoutLC, vVarApps, - vCaseDEFAULT, vCaseProd + vCaseDEFAULT ) where #include "HsVersions.h" import CoreSyn -import CoreUtils ( exprType ) -import DataCon ( DataCon ) import Type ( Type ) -import Id ( mkWildId ) import Var type Vect a = (a,a) @@ -44,6 +36,9 @@ mapVect f (x,y) = (f x, f y) zipWithVect :: (a -> b -> c) -> Vect a -> Vect b -> Vect c zipWithVect f (x1,y1) (x2,y2) = (f x1 x2, f y1 y2) +vVarType :: VVar -> Type +vVarType = varType . vectorised + vVar :: VVar -> VExpr vVar = mapVect Var @@ -87,13 +82,3 @@ vCaseDEFAULT (vscrut, lscrut) (vbndr, lbndr) vty lty (vbody, lbody) where mkDEFAULT e = [(DEFAULT, [], e)] -vCaseProd :: VExpr -> Type -> Type - -> DataCon -> DataCon -> [Var] -> [VVar] -> VExpr -> VExpr -vCaseProd (vscrut, lscrut) vty lty vdc ldc sh_bndrs bndrs - (vbody,lbody) - = (Case vscrut (mkWildId $ exprType vscrut) vty - [(DataAlt vdc, vbndrs, vbody)], - Case lscrut (mkWildId $ exprType lscrut) lty - [(DataAlt ldc, sh_bndrs ++ lbndrs, lbody)]) - where - (vbndrs, lbndrs) = unzip bndrs