Add built-ins to vectorisation monad

[ghc-hetmet.git] / compiler / vectorise / VectMonad.hs

diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 9a680e7..22b776e 100644 (file)
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -3,6 +3,7 @@ module VectMonad (
   VM,
 
   noV, tryV, maybeV, traceMaybeV, orElseV, fixV, localV, closedV, initV,
+  liftDs,
   cloneName, cloneId,
   newExportedVar, newLocalVar, newDummyVar, newTyVar,
   
@@ -66,6 +67,14 @@ data Builtins = Builtins {
                   parrayTyCon      :: TyCon
                 , paTyCon          :: TyCon
                 , paDataCon        :: DataCon
+                , preprTyCon       :: TyCon
+                , embedTyCon       :: TyCon
+                , embedDataCon     :: DataCon
+                , crossTyCon       :: TyCon
+                , crossDataCon     :: DataCon
+                , plusTyCon        :: TyCon
+                , leftDataCon      :: DataCon
+                , rightDataCon     :: DataCon
                 , closureTyCon     :: TyCon
                 , mkClosureVar     :: Var
                 , applyClosureVar  :: Var
@@ -74,8 +83,8 @@ data Builtins = Builtins {
                 , lengthPAVar      :: Var
                 , replicatePAVar   :: Var
                 , emptyPAVar       :: Var
-                , packPAVar        :: Var
-                , combinePAVar     :: Var
+                -- , packPAVar        :: Var
+                -- , combinePAVar     :: Var
                 , intEqPAVar       :: Var
                 , liftingContext   :: Var
                 }
@@ -85,7 +94,14 @@ initBuiltins
   = do
       parrayTyCon  <- dsLookupTyCon parrayTyConName
       paTyCon      <- dsLookupTyCon paTyConName
-      let paDataCon = case tyConDataCons paTyCon of [dc] -> dc
+      let [paDataCon] = tyConDataCons paTyCon
+      preprTyCon   <- dsLookupTyCon preprTyConName
+      embedTyCon   <- dsLookupTyCon embedTyConName
+      let [embedDataCon] = tyConDataCons embedTyCon
+      crossTyCon   <- dsLookupTyCon crossTyConName
+      let [crossDataCon] = tyConDataCons crossTyCon
+      plusTyCon    <- dsLookupTyCon plusTyConName
+      let [leftDataCon, rightDataCon] = tyConDataCons plusTyCon
       closureTyCon <- dsLookupTyCon closureTyConName
 
       mkClosureVar     <- dsLookupGlobalId mkClosureName
@@ -95,8 +111,8 @@ initBuiltins
       lengthPAVar      <- dsLookupGlobalId lengthPAName
       replicatePAVar   <- dsLookupGlobalId replicatePAName
       emptyPAVar       <- dsLookupGlobalId emptyPAName
-      packPAVar        <- dsLookupGlobalId packPAName
-      combinePAVar     <- dsLookupGlobalId combinePAName
+      -- packPAVar        <- dsLookupGlobalId packPAName
+      -- combinePAVar     <- dsLookupGlobalId combinePAName
       intEqPAVar       <- dsLookupGlobalId intEqPAName
 
       liftingContext <- liftM (\u -> mkSysLocal FSLIT("lc") u intPrimTy)
@@ -106,6 +122,14 @@ initBuiltins
                  parrayTyCon      = parrayTyCon
                , paTyCon          = paTyCon
                , paDataCon        = paDataCon
+               , preprTyCon       = preprTyCon
+               , embedTyCon       = embedTyCon
+               , embedDataCon     = embedDataCon
+               , crossTyCon       = crossTyCon
+               , crossDataCon     = crossDataCon
+               , plusTyCon        = plusTyCon
+               , leftDataCon      = leftDataCon
+               , rightDataCon     = rightDataCon
                , closureTyCon     = closureTyCon
                , mkClosureVar     = mkClosureVar
                , applyClosureVar  = applyClosureVar
@@ -114,8 +138,8 @@ initBuiltins
                , lengthPAVar      = lengthPAVar
                , replicatePAVar   = replicatePAVar
                , emptyPAVar       = emptyPAVar
-               , packPAVar        = packPAVar
-               , combinePAVar     = combinePAVar
+               -- , packPAVar        = packPAVar
+               -- , combinePAVar     = combinePAVar
                , intEqPAVar       = intEqPAVar
                , liftingContext   = liftingContext
                }