compiler/vectorise/VectBuiltIn.hs

   1 module VectBuiltIn (
   2   Builtins(..), initBuiltins
   3 ) where
   4
   5 #include "HsVersions.h"
   6
   7 import DsMonad
   8
   9 import DataCon         ( DataCon )
  10 import TyCon           ( TyCon, tyConDataCons )
  11 import Var             ( Var )
  12 import Id              ( mkSysLocal )
  13
  14 import TysPrim         ( intPrimTy )
  15 import PrelNames
  16
  17 import Control.Monad   ( liftM )
  18
  19 data Builtins = Builtins {
  20                   parrayTyCon      :: TyCon
  21                 , paTyCon          :: TyCon
  22                 , paDataCon        :: DataCon
  23                 , preprTyCon       :: TyCon
  24                 , prTyCon          :: TyCon
  25                 , prDataCon        :: DataCon
  26                 , embedTyCon       :: TyCon
  27                 , embedDataCon     :: DataCon
  28                 , crossTyCon       :: TyCon
  29                 , crossDataCon     :: DataCon
  30                 , plusTyCon        :: TyCon
  31                 , leftDataCon      :: DataCon
  32                 , rightDataCon     :: DataCon
  33                 , closureTyCon     :: TyCon
  34                 , mkClosureVar     :: Var
  35                 , applyClosureVar  :: Var
  36                 , mkClosurePVar    :: Var
  37                 , applyClosurePVar :: Var
  38                 , lengthPAVar      :: Var
  39                 , replicatePAVar   :: Var
  40                 , emptyPAVar       :: Var
  41                 -- , packPAVar        :: Var
  42                 -- , combinePAVar     :: Var
  43                 , intEqPAVar       :: Var
  44                 , liftingContext   :: Var
  45                 }
  46
  47 initBuiltins :: DsM Builtins
  48 initBuiltins
  49   = do
  50       parrayTyCon  <- dsLookupTyCon parrayTyConName
  51       paTyCon      <- dsLookupTyCon paTyConName
  52       let [paDataCon] = tyConDataCons paTyCon
  53       preprTyCon   <- dsLookupTyCon preprTyConName
  54       prTyCon      <- dsLookupTyCon prTyConName
  55       let [prDataCon] = tyConDataCons prTyCon
  56       embedTyCon   <- dsLookupTyCon embedTyConName
  57       let [embedDataCon] = tyConDataCons embedTyCon
  58       crossTyCon   <- dsLookupTyCon ndpCrossTyConName
  59       let [crossDataCon] = tyConDataCons crossTyCon
  60       plusTyCon    <- dsLookupTyCon ndpPlusTyConName
  61       let [leftDataCon, rightDataCon] = tyConDataCons plusTyCon
  62       closureTyCon <- dsLookupTyCon closureTyConName
  63
  64       mkClosureVar     <- dsLookupGlobalId mkClosureName
  65       applyClosureVar  <- dsLookupGlobalId applyClosureName
  66       mkClosurePVar    <- dsLookupGlobalId mkClosurePName
  67       applyClosurePVar <- dsLookupGlobalId applyClosurePName
  68       lengthPAVar      <- dsLookupGlobalId lengthPAName
  69       replicatePAVar   <- dsLookupGlobalId replicatePAName
  70       emptyPAVar       <- dsLookupGlobalId emptyPAName
  71       -- packPAVar        <- dsLookupGlobalId packPAName
  72       -- combinePAVar     <- dsLookupGlobalId combinePAName
  73       intEqPAVar       <- dsLookupGlobalId intEqPAName
  74
  75       liftingContext <- liftM (\u -> mkSysLocal FSLIT("lc") u intPrimTy)
  76                               newUnique
  77
  78       return $ Builtins {
  79                  parrayTyCon      = parrayTyCon
  80                , paTyCon          = paTyCon
  81                , paDataCon        = paDataCon
  82                , preprTyCon       = preprTyCon
  83                , prTyCon          = prTyCon
  84                , prDataCon        = prDataCon
  85                , embedTyCon       = embedTyCon
  86                , embedDataCon     = embedDataCon
  87                , crossTyCon       = crossTyCon
  88                , crossDataCon     = crossDataCon
  89                , plusTyCon        = plusTyCon
  90                , leftDataCon      = leftDataCon
  91                , rightDataCon     = rightDataCon
  92                , closureTyCon     = closureTyCon
  93                , mkClosureVar     = mkClosureVar
  94                , applyClosureVar  = applyClosureVar
  95                , mkClosurePVar    = mkClosurePVar
  96                , applyClosurePVar = applyClosurePVar
  97                , lengthPAVar      = lengthPAVar
  98                , replicatePAVar   = replicatePAVar
  99                , emptyPAVar       = emptyPAVar
 100                -- , packPAVar        = packPAVar
 101                -- , combinePAVar     = combinePAVar
 102                , intEqPAVar       = intEqPAVar
 103                , liftingContext   = liftingContext
 104                }
 105
 106