--- /dev/null
+module VectCore (
+ Vect, VVar, VExpr,
+
+ vectorised, lifted,
+ mapVect,
+
+ vVar, mkVLams, mkVVarApps
+) where
+
+#include "HsVersions.h"
+
+import CoreSyn
+import Var
+
+type Vect a = (a,a)
+type VVar = Vect Var
+type VExpr = Vect CoreExpr
+
+vectorised :: Vect a -> a
+vectorised = fst
+
+lifted :: Vect a -> a
+lifted = snd
+
+mapVect :: (a -> b) -> Vect a -> Vect b
+mapVect f (x,y) = (f x, f y)
+
+vVar :: VVar -> VExpr
+vVar = mapVect Var
+
+mkVLams :: [VVar] -> VExpr -> VExpr
+mkVLams vvs (ve,le) = (mkLams vs ve, mkLams ls le)
+ where
+ (vs,ls) = unzip vvs
+
+mkVVarApps :: Var -> VExpr -> [VVar] -> VExpr
+mkVVarApps lc (ve, le) vvs = (ve `mkVarApps` vs, le `mkVarApps` (lc : ls))
+ where
+ (vs,ls) = unzip vvs
+
+
#include "HsVersions.h"
+import VectCore
import VectMonad
import DsUtils
emptyPA :: Type -> VM CoreExpr
emptyPA = paMethod emptyPAVar
-type Vect a = (a,a)
-type VVar = Vect Var
-type VExpr = Vect CoreExpr
-
-vectorised :: Vect a -> a
-vectorised = fst
-
-lifted :: Vect a -> a
-lifted = snd
-
-mapVect :: (a -> b) -> Vect a -> Vect b
-mapVect f (x,y) = (f x, f y)
-
newLocalVVar :: FastString -> Type -> VM VVar
newLocalVVar fs vty
= do
lv <- newLocalVar fs lty
return (vv,lv)
-vVar :: VVar -> VExpr
-vVar = mapVect Var
-
-mkVLams :: [VVar] -> VExpr -> VExpr
-mkVLams vvs (ve,le) = (mkLams vs ve, mkLams ls le)
- where
- (vs,ls) = unzip vvs
-
-mkVVarApps :: Var -> VExpr -> [VVar] -> VExpr
-mkVVarApps lc (ve, le) vvs = (ve `mkVarApps` vs, le `mkVarApps` (lc : ls))
- where
- (vs,ls) = unzip vvs
-
polyAbstract :: [TyVar] -> ((CoreExpr -> CoreExpr) -> VM a) -> VM a
polyAbstract tvs p
= localV
env_bndr <- newLocalVVar FSLIT("env") env_ty
fn <- hoistPolyVExpr FSLIT("fn") tvs
- . mkVLams [env_bndr, arg]
+ . mkVLams [env_bndr, arg]
. bind (vVar env_bndr)
$ mkVVarApps lv body (vars ++ [arg])