X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectCore.hs;fp=compiler%2Fvectorise%2FVectCore.hs;h=9118214b4ce02a368e8cb53905099adaf73d707f;hb=02cff9dfe0e5f6b9a92949ee988989e16d764f8b;hp=63178bd5d7d1b7fdcaccf12c2776135e0e4afc9d;hpb=f3114b4ac0b4316bf7acb9469c400b3d1c483c6c;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectCore.hs b/compiler/vectorise/VectCore.hs index 63178bd..9118214 100644 --- a/compiler/vectorise/VectCore.hs +++ b/compiler/vectorise/VectCore.hs @@ -1,20 +1,25 @@ module VectCore ( - Vect, VVar, VExpr, + Vect, VVar, VExpr, VBind, vectorised, lifted, mapVect, - vVar, mkVLams, mkVVarApps + vNonRec, vRec, + + vVar, vType, vNote, vLet, + mkVLams, mkVVarApps ) where #include "HsVersions.h" import CoreSyn +import Type ( Type ) import Var type Vect a = (a,a) type VVar = Vect Var type VExpr = Vect CoreExpr +type VBind = Vect CoreBind vectorised :: Vect a -> a vectorised = fst @@ -25,9 +30,30 @@ lifted = snd mapVect :: (a -> b) -> Vect a -> Vect b 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) + vVar :: VVar -> VExpr vVar = mapVect Var +vType :: Type -> VExpr +vType ty = (Type ty, Type ty) + +vNote :: Note -> VExpr -> VExpr +vNote = mapVect . Note + +vNonRec :: VVar -> VExpr -> VBind +vNonRec = zipWithVect NonRec + +vRec :: [VVar] -> [VExpr] -> VBind +vRec vs es = (Rec (zip vvs ves), Rec (zip lvs les)) + where + (vvs, lvs) = unzip vs + (ves, les) = unzip es + +vLet :: VBind -> VExpr -> VExpr +vLet = zipWithVect Let + mkVLams :: [VVar] -> VExpr -> VExpr mkVLams vvs (ve,le) = (mkLams vs ve, mkLams ls le) where