Move vectorisation built-ins to a separate module

diff --git a/compiler/package.conf.in b/compiler/package.conf.in
index e654822..2342e14 100644 (file)
--- a/compiler/package.conf.in
+++ b/compiler/package.conf.in
@@ -259,6 +259,7 @@ exposed-modules:
        Var
        VarEnv
        VarSet
+        VectBuiltIn
         VectCore
         VectMonad
         VectType

diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs
new file mode 100644 (file)
index 0000000..1ff3418
--- /dev/null
+++ b/compiler/vectorise/VectBuiltIn.hs
@@ -0,0 +1,106 @@
+module VectBuiltIn (
+  Builtins(..), initBuiltins
+) where
+
+#include "HsVersions.h"
+
+import DsMonad
+
+import DataCon         ( DataCon )
+import TyCon           ( TyCon, tyConDataCons )
+import Var             ( Var )
+import Id              ( mkSysLocal )
+
+import TysPrim         ( intPrimTy )
+import PrelNames
+
+import Control.Monad   ( liftM )
+
+data Builtins = Builtins {
+                  parrayTyCon      :: TyCon
+                , paTyCon          :: TyCon
+                , paDataCon        :: DataCon
+                , preprTyCon       :: TyCon
+                , prTyCon          :: TyCon
+                , prDataCon        :: DataCon
+                , embedTyCon       :: TyCon
+                , embedDataCon     :: DataCon
+                , crossTyCon       :: TyCon
+                , crossDataCon     :: DataCon
+                , plusTyCon        :: TyCon
+                , leftDataCon      :: DataCon
+                , rightDataCon     :: DataCon
+                , closureTyCon     :: TyCon
+                , mkClosureVar     :: Var
+                , applyClosureVar  :: Var
+                , mkClosurePVar    :: Var
+                , applyClosurePVar :: Var
+                , lengthPAVar      :: Var
+                , replicatePAVar   :: Var
+                , emptyPAVar       :: Var
+                -- , packPAVar        :: Var
+                -- , combinePAVar     :: Var
+                , intEqPAVar       :: Var
+                , liftingContext   :: Var
+                }
+
+initBuiltins :: DsM Builtins
+initBuiltins
+  = do
+      parrayTyCon  <- dsLookupTyCon parrayTyConName
+      paTyCon      <- dsLookupTyCon paTyConName
+      let [paDataCon] = tyConDataCons paTyCon
+      preprTyCon   <- dsLookupTyCon preprTyConName
+      prTyCon      <- dsLookupTyCon prTyConName
+      let [prDataCon] = tyConDataCons prTyCon
+      embedTyCon   <- dsLookupTyCon embedTyConName
+      let [embedDataCon] = tyConDataCons embedTyCon
+      crossTyCon   <- dsLookupTyCon ndpCrossTyConName
+      let [crossDataCon] = tyConDataCons crossTyCon
+      plusTyCon    <- dsLookupTyCon ndpPlusTyConName
+      let [leftDataCon, rightDataCon] = tyConDataCons plusTyCon
+      closureTyCon <- dsLookupTyCon closureTyConName
+
+      mkClosureVar     <- dsLookupGlobalId mkClosureName
+      applyClosureVar  <- dsLookupGlobalId applyClosureName
+      mkClosurePVar    <- dsLookupGlobalId mkClosurePName
+      applyClosurePVar <- dsLookupGlobalId applyClosurePName
+      lengthPAVar      <- dsLookupGlobalId lengthPAName
+      replicatePAVar   <- dsLookupGlobalId replicatePAName
+      emptyPAVar       <- dsLookupGlobalId emptyPAName
+      -- packPAVar        <- dsLookupGlobalId packPAName
+      -- combinePAVar     <- dsLookupGlobalId combinePAName
+      intEqPAVar       <- dsLookupGlobalId intEqPAName
+
+      liftingContext <- liftM (\u -> mkSysLocal FSLIT("lc") u intPrimTy)
+                              newUnique
+
+      return $ Builtins {
+                 parrayTyCon      = parrayTyCon
+               , paTyCon          = paTyCon
+               , paDataCon        = paDataCon
+               , preprTyCon       = preprTyCon
+               , prTyCon          = prTyCon
+               , prDataCon        = prDataCon
+               , embedTyCon       = embedTyCon
+               , embedDataCon     = embedDataCon
+               , crossTyCon       = crossTyCon
+               , crossDataCon     = crossDataCon
+               , plusTyCon        = plusTyCon
+               , leftDataCon      = leftDataCon
+               , rightDataCon     = rightDataCon
+               , closureTyCon     = closureTyCon
+               , mkClosureVar     = mkClosureVar
+               , applyClosureVar  = applyClosureVar
+               , mkClosurePVar    = mkClosurePVar
+               , applyClosurePVar = applyClosurePVar
+               , lengthPAVar      = lengthPAVar
+               , replicatePAVar   = replicatePAVar
+               , emptyPAVar       = emptyPAVar
+               -- , packPAVar        = packPAVar
+               -- , combinePAVar     = combinePAVar
+               , intEqPAVar       = intEqPAVar
+               , liftingContext   = liftingContext
+               }
+
+

diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 9fe6755..75df2b7 100644 (file)
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -30,6 +30,8 @@ module VectMonad (
 
 #include "HsVersions.h"
 
+import VectBuiltIn
+
 import HscTypes
 import CoreSyn
 import TyCon
@@ -64,93 +66,6 @@ data Scope a b = Global a | Local b
 -- ----------------------------------------------------------------------------
 -- Vectorisation monad
 
-data Builtins = Builtins {
-                  parrayTyCon      :: TyCon
-                , paTyCon          :: TyCon
-                , paDataCon        :: DataCon
-                , preprTyCon       :: TyCon
-                , prTyCon          :: TyCon
-                , prDataCon        :: DataCon
-                , embedTyCon       :: TyCon
-                , embedDataCon     :: DataCon
-                , crossTyCon       :: TyCon
-                , crossDataCon     :: DataCon
-                , plusTyCon        :: TyCon
-                , leftDataCon      :: DataCon
-                , rightDataCon     :: DataCon
-                , closureTyCon     :: TyCon
-                , mkClosureVar     :: Var
-                , applyClosureVar  :: Var
-                , mkClosurePVar    :: Var
-                , applyClosurePVar :: Var
-                , lengthPAVar      :: Var
-                , replicatePAVar   :: Var
-                , emptyPAVar       :: Var
-                -- , packPAVar        :: Var
-                -- , combinePAVar     :: Var
-                , intEqPAVar       :: Var
-                , liftingContext   :: Var
-                }
-
-initBuiltins :: DsM Builtins
-initBuiltins
-  = do
-      parrayTyCon  <- dsLookupTyCon parrayTyConName
-      paTyCon      <- dsLookupTyCon paTyConName
-      let [paDataCon] = tyConDataCons paTyCon
-      preprTyCon   <- dsLookupTyCon preprTyConName
-      prTyCon      <- dsLookupTyCon prTyConName
-      let [prDataCon] = tyConDataCons prTyCon
-      embedTyCon   <- dsLookupTyCon embedTyConName
-      let [embedDataCon] = tyConDataCons embedTyCon
-      crossTyCon   <- dsLookupTyCon ndpCrossTyConName
-      let [crossDataCon] = tyConDataCons crossTyCon
-      plusTyCon    <- dsLookupTyCon ndpPlusTyConName
-      let [leftDataCon, rightDataCon] = tyConDataCons plusTyCon
-      closureTyCon <- dsLookupTyCon closureTyConName
-
-      mkClosureVar     <- dsLookupGlobalId mkClosureName
-      applyClosureVar  <- dsLookupGlobalId applyClosureName
-      mkClosurePVar    <- dsLookupGlobalId mkClosurePName
-      applyClosurePVar <- dsLookupGlobalId applyClosurePName
-      lengthPAVar      <- dsLookupGlobalId lengthPAName
-      replicatePAVar   <- dsLookupGlobalId replicatePAName
-      emptyPAVar       <- dsLookupGlobalId emptyPAName
-      -- packPAVar        <- dsLookupGlobalId packPAName
-      -- combinePAVar     <- dsLookupGlobalId combinePAName
-      intEqPAVar       <- dsLookupGlobalId intEqPAName
-
-      liftingContext <- liftM (\u -> mkSysLocal FSLIT("lc") u intPrimTy)
-                              newUnique
-
-      return $ Builtins {
-                 parrayTyCon      = parrayTyCon
-               , paTyCon          = paTyCon
-               , paDataCon        = paDataCon
-               , preprTyCon       = preprTyCon
-               , prTyCon          = prTyCon
-               , prDataCon        = prDataCon
-               , embedTyCon       = embedTyCon
-               , embedDataCon     = embedDataCon
-               , crossTyCon       = crossTyCon
-               , crossDataCon     = crossDataCon
-               , plusTyCon        = plusTyCon
-               , leftDataCon      = leftDataCon
-               , rightDataCon     = rightDataCon
-               , closureTyCon     = closureTyCon
-               , mkClosureVar     = mkClosureVar
-               , applyClosureVar  = applyClosureVar
-               , mkClosurePVar    = mkClosurePVar
-               , applyClosurePVar = applyClosurePVar
-               , lengthPAVar      = lengthPAVar
-               , replicatePAVar   = replicatePAVar
-               , emptyPAVar       = emptyPAVar
-               -- , packPAVar        = packPAVar
-               -- , combinePAVar     = combinePAVar
-               , intEqPAVar       = intEqPAVar
-               , liftingContext   = liftingContext
-               }
-
 data GlobalEnv = GlobalEnv {
                   -- Mapping from global variables to their vectorised versions.
                   --