X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FBuiltins%2FInitialise.hs;h=94de62aa72300b6b114946fed2259c3beaf9803a;hp=413980a1c3031602ff6d65d369be8ebe9dbece63;hb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd;hpb=0e82126ed0bd2d16a1925d8a8a6c5eb6d7762ac5

diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
index 413980a..94de62a 100644
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
@@ -22,7 +22,6 @@ import TyCon
 import Class
 import CoreSyn
 import Type
-import OccName
 import Name
 import Module
 import Var
@@ -47,12 +46,15 @@ initBuiltins pkg
       let [parrayDataCon] = tyConDataCons parrayTyCon
 
       pdataTyCon	<- externalTyCon	dph_PArray	(fsLit "PData")
-      paTyCon		<- externalClassTyCon	dph_PArray	(fsLit "PA")
-      let [paDataCon]	= tyConDataCons paTyCon
+      paClass           <- externalClass        dph_PArray      (fsLit "PA")
+      let paTyCon     = classTyCon paClass
+          [paDataCon] = tyConDataCons paTyCon
+          paPRSel     = classSCSelId paClass 0
 
       preprTyCon	<- externalTyCon 	dph_PArray	(fsLit "PRepr")
-      prTyCon		<- externalClassTyCon	dph_PArray	(fsLit "PR")
-      let [prDataCon]	= tyConDataCons prTyCon
+      prClass           <- externalClass        dph_PArray      (fsLit "PR")
+      let prTyCon     = classTyCon prClass
+          [prDataCon] = tyConDataCons prTyCon
 
       closureTyCon	<- externalTyCon dph_Closure		(fsLit ":->")
 
@@ -126,9 +128,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
@@ -186,10 +191,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
@@ -198,7 +204,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]
@@ -268,12 +274,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
@@ -306,9 +312,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)
-
-