Update vectoriser now that PData has moved.

[ghc-hetmet.git] / compiler / vectorise / Vectorise / Builtins / Initialise.hs

diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
index d9a1f0d..5f4735c 100644 (file)
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
@@ -24,7 +24,6 @@ import CoreSyn
 import Type
 import Name
 import Module
-import Var
 import Id
 import FastString
 import Outputable
@@ -41,19 +40,29 @@ initBuiltins
 initBuiltins pkg
  = do mapM_ load dph_Orphans
 
+      -- From dph-common:Data.Array.Parallel.PArray.PData
+      --   PData is a type family that maps an element type onto the type
+      --   we use to hold an array of those elements.
+      pdataTyCon       <- externalTyCon        dph_PData       (fsLit "PData")
+
+      --   PR is a type class that holds the primitive operators we can 
+      --   apply to array data. Its functions take arrays in terms of PData types.
+      prClass           <- externalClass        dph_PData      (fsLit "PR")
+      let prTyCon     = classTyCon prClass
+          [prDataCon] = tyConDataCons prTyCon
+
       -- From dph-common:Data.Array.Parallel.Lifted.PArray
+      --   A PArray (Parallel Array) holds the array length and some array elements
+      --   represented by the PData type family.
       parrayTyCon      <- externalTyCon        dph_PArray      (fsLit "PArray")
       let [parrayDataCon] = tyConDataCons parrayTyCon
 
-      pdataTyCon       <- externalTyCon        dph_PArray      (fsLit "PData")
-      pa                <- externalClass        dph_PArray      (fsLit "PA")
-      let paTyCon     = classTyCon pa
+      paClass           <- externalClass        dph_PArray      (fsLit "PA")
+      let paTyCon     = classTyCon paClass
           [paDataCon] = tyConDataCons paTyCon
-          paPRSel     = classSCSelId pa 0
+          paPRSel     = classSCSelId paClass 0
 
       preprTyCon       <- externalTyCon        dph_PArray      (fsLit "PRepr")
-      prTyCon          <- externalClassTyCon   dph_PArray      (fsLit "PR")
-      let [prDataCon]  = tyConDataCons prTyCon
 
       closureTyCon     <- externalTyCon dph_Closure            (fsLit ":->")
 
@@ -127,10 +136,12 @@ initBuiltins pkg
                , parrayTyCon      = parrayTyCon
                , parrayDataCon    = parrayDataCon
                , pdataTyCon       = pdataTyCon
+               , paClass          = paClass
                , paTyCon          = paTyCon
                , paDataCon        = paDataCon
                , paPRSel          = paPRSel
                , preprTyCon       = preprTyCon
+               , prClass          = prClass
                , prTyCon          = prTyCon
                , prDataCon        = prDataCon
                , voidTyCon        = voidTyCon
@@ -160,13 +171,17 @@ initBuiltins pkg
                , liftingContext   = liftingContext
                }
   where
-    mods@(Modules {
-               dph_PArray         = dph_PArray
-             , dph_Repr           = dph_Repr
-             , dph_Closure        = dph_Closure
-             , dph_Scalar         = dph_Scalar
-             , dph_Unboxed        = dph_Unboxed
-             })
+    -- Extract out all the modules we'll use.
+    -- These are the modules from the DPH base library that contain
+    --  the primitive array types and functions that vectorised code uses.
+    mods@(Modules 
+                { dph_PArray    = dph_PArray
+                , dph_PData     = dph_PData
+                , dph_Repr      = dph_Repr
+                , dph_Closure   = dph_Closure
+                , dph_Scalar    = dph_Scalar
+                , dph_Unboxed   = dph_Unboxed
+                })
       = dph_Modules pkg
 
     load get_mod = dsLoadModule doc mod
@@ -188,10 +203,11 @@ initBuiltins pkg
              $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
           return ((i,j), Var v)
 
-
 -- | Get the mapping of names in the Prelude to names in the DPH library.
-initBuiltinVars :: Builtins -> DsM [(Var, Var)]
-initBuiltinVars (Builtins { dphModules = mods })
+--
+initBuiltinVars :: Bool   -- FIXME
+                -> Builtins -> DsM [(Var, Var)]
+initBuiltinVars compilingDPH (Builtins { dphModules = mods })
   = do
       uvars <- zipWithM externalVar umods ufs
       vvars <- zipWithM externalVar vmods vfs
@@ -200,7 +216,7 @@ initBuiltinVars (Builtins { dphModules = mods })
                ++ zip (map dataConWorkId cons) cvars
                ++ zip uvars vvars
   where
-    (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
+    (umods, ufs, vmods, vfs) = if compilingDPH then ([], [], [], []) else unzip4 (preludeVars mods)
     (cons, cmods, cfs)       = unzip3 (preludeDataCons mods)
 
     defaultDataConWorkers :: [DataCon]
@@ -251,7 +267,7 @@ initBuiltinPAs (Builtins { dphModules = mods }) insts
 -- | Get the names of all builtin instance functions for the PR class.
 initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
 initBuiltinPRs (Builtins { dphModules = mods }) insts
-  = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PR"))
+  = liftM (initBuiltinDicts insts) (externalClass (dph_PData mods) (fsLit "PR"))
 
 
 -- | Get the names of all DPH instance functions for this class.
@@ -270,12 +286,12 @@ initBuiltinBoxedTyCons
        builtinBoxedTyCons _ 
                = [(tyConName intPrimTyCon, intTyCon)]
 
-
 -- | Get a list of all scalar functions in the mock prelude.
-initBuiltinScalars :: Builtins -> DsM [Var]
-initBuiltinScalars bi
-  = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
-
+--
+initBuiltinScalars :: Bool 
+                   -> Builtins -> DsM [Var]
+initBuiltinScalars True  _bi = return []
+initBuiltinScalars False bi  = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
 
 -- | Lookup some variable given its name and the module that contains it.
 externalVar :: Module -> FastString -> DsM Var
@@ -308,9 +324,3 @@ externalClass :: Module -> FastString -> DsM Class
 externalClass mod fs
   = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs)
 
-
--- | Like `externalClass`, but get the TyCon of of the class.
-externalClassTyCon :: Module -> FastString -> DsM TyCon
-externalClassTyCon mod fs = liftM classTyCon (externalClass mod fs)
-
-