GHC is now independent of the DPH library structure

* if -XParallelArrays is given, the symbols for the desugarer are
  taken from 'Data.Array.Parallel' (from whichever package is
  exposed and has the module — the home package is fine, too)
* if -fvectorise is given, the symbols for the vectoriser are
  taken from 'Data.Array.Parallel.Prim' (as above)

(There is one wired in symbol left, namely the data constructor
'base:GHC.PArr.[::]. It'll die another day.)

compiler/deSugar/DsExpr.lhs

@@ -365,11 +365,11 @@ dsExpr (ExplicitList elt_ty xs)
 --   singletonP x1 +:+ ... +:+ singletonP xn
 --
 dsExpr (ExplicitPArr ty []) = do
-    emptyP <- dsLookupDPHId emptyPName
+    emptyP <- dsDPHBuiltin emptyPVar
     return (Var emptyP `App` Type ty)
 dsExpr (ExplicitPArr ty xs) = do
-    singletonP <- dsLookupDPHId singletonPName
-    appP       <- dsLookupDPHId appPName
+    singletonP <- dsDPHBuiltin singletonPVar
+    appP       <- dsDPHBuiltin appPVar
     xs'        <- mapM dsLExpr xs
     return . foldr1 (binary appP) $ map (unary singletonP) xs'
   where

compiler/deSugar/DsListComp.lhs

@@ -484,7 +484,7 @@ dsPArrComp (ParStmt qss _ _ _ : quals) = dePArrParComp qss quals
 --    <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)
 --
 dsPArrComp (BindStmt p e _ _ : qs) = do
-    filterP <- dsLookupDPHId filterPName
+    filterP <- dsDPHBuiltin filterPVar
     ce <- dsLExpr e
     let ety'ce  = parrElemType ce
         false   = Var falseDataConId
@@ -496,7 +496,7 @@ dsPArrComp (BindStmt p e _ _ : qs) = do
     dePArrComp qs p gen
 
 dsPArrComp qs = do -- no ParStmt in `qs'
-    sglP <- dsLookupDPHId singletonPName
+    sglP <- dsDPHBuiltin singletonPVar
     let unitArray = mkApps (Var sglP) [Type unitTy, mkCoreTup []]
     dePArrComp qs (noLoc $ WildPat unitTy) unitArray
 
@@ -516,7 +516,7 @@ dePArrComp [] _ _ = panic "dePArrComp"
 --
 dePArrComp (LastStmt e' _ : quals) pa cea
   = ASSERT( null quals )
-    do { mapP <- dsLookupDPHId mapPName
+    do { mapP <- dsDPHBuiltin mapPVar
        ; let ty = parrElemType cea
        ; (clam, ty'e') <- deLambda ty pa e'
        ; return $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea] }
@@ -524,7 +524,7 @@ dePArrComp (LastStmt e' _ : quals) pa cea
 --  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
 --
 dePArrComp (ExprStmt b _ _ _ : qs) pa cea = do
-    filterP <- dsLookupDPHId filterPName
+    filterP <- dsDPHBuiltin filterPVar
     let ty = parrElemType cea
     (clam,_) <- deLambda ty pa b
     dePArrComp qs pa (mkApps (Var filterP) [Type ty, clam, cea])
@@ -543,8 +543,8 @@ dePArrComp (ExprStmt b _ _ _ : qs) pa cea = do
 --    <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)
 --
 dePArrComp (BindStmt p e _ _ : qs) pa cea = do
-    filterP <- dsLookupDPHId filterPName
-    crossMapP <- dsLookupDPHId crossMapPName
+    filterP <- dsDPHBuiltin filterPVar
+    crossMapP <- dsDPHBuiltin crossMapPVar
     ce <- dsLExpr e
     let ety'cea = parrElemType cea
         ety'ce  = parrElemType ce
@@ -568,7 +568,7 @@ dePArrComp (BindStmt p e _ _ : qs) pa cea = do
 --    {x_1, ..., x_n} = DV (ds)         -- Defined Variables
 --
 dePArrComp (LetStmt ds : qs) pa cea = do
-    mapP <- dsLookupDPHId mapPName
+    mapP <- dsDPHBuiltin mapPVar
     let xs     = collectLocalBinders ds
         ty'cea = parrElemType cea
     v <- newSysLocalDs ty'cea
@@ -615,7 +615,7 @@ dePArrParComp qss quals = do
     ---
     parStmts []             pa cea = return (pa, cea)
     parStmts ((qs, xs):qss) pa cea = do  -- subsequent statements (zip'ed)
-      zipP <- dsLookupDPHId zipPName
+      zipP <- dsDPHBuiltin zipPVar
       let pa'      = mkLHsPatTup [pa, mkLHsVarPatTup xs]
           ty'cea   = parrElemType cea
           res_expr = mkLHsVarTuple xs

compiler/deSugar/DsMonad.lhs

@@ -21,9 +21,9 @@ module DsMonad (
         newUnique, 
         UniqSupply, newUniqueSupply,
         getDOptsDs, getGhcModeDs, doptDs, woptDs,
-        dsLookupGlobal, dsLookupGlobalId, dsLookupDPHId, dsLookupTyCon, dsLookupDataCon,
+        dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
         
-        assertDAPPLoaded, lookupDAPPRdrEnv,
+        PArrBuiltin(..), dsLookupDPHRdrEnv, dsInitPArrBuiltin,
 
         DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
 
@@ -41,6 +41,7 @@ import CoreSyn
 import HsSyn
 import TcIface
 import LoadIface
+import Finder
 import PrelNames
 import Avail
 import RdrName
@@ -60,7 +61,6 @@ import DynFlags
 import ErrUtils
 import FastString
 import Maybes
-import Control.Monad
 
 import Data.IORef
 \end{code}
@@ -131,16 +131,38 @@ type DsWarning = (SrcSpan, SDoc)
         -- and we'll do the print_unqual stuff later on to turn it
         -- into a Doc.
 
-data DsGblEnv = DsGblEnv {
-        ds_mod     :: Module,                   -- For SCC profiling
-        ds_unqual  :: PrintUnqualified,
-        ds_msgs    :: IORef Messages,           -- Warning messages
-        ds_if_env  :: (IfGblEnv, IfLclEnv),     -- Used for looking up global, 
+-- If '-XParallelArrays' is given, the desugarer populates this table with the corresponding
+-- variables found in 'Data.Array.Parallel'.
+--
+data PArrBuiltin
+        = PArrBuiltin
+        { lengthPVar         :: Var     -- ^ lengthP
+        , replicatePVar      :: Var     -- ^ replicateP
+        , singletonPVar      :: Var     -- ^ singletonP
+        , mapPVar            :: Var     -- ^ mapP
+        , filterPVar         :: Var     -- ^ filterP
+        , zipPVar            :: Var     -- ^ zipP
+        , crossMapPVar       :: Var     -- ^ crossMapP
+        , indexPVar          :: Var     -- ^ (!:)
+        , emptyPVar          :: Var     -- ^ emptyP
+        , appPVar            :: Var     -- ^ (+:+)
+        , enumFromToPVar     :: Var     -- ^ enumFromToP
+        , enumFromThenToPVar :: Var     -- ^ enumFromThenToP
+        }
+
+data DsGblEnv 
+        = DsGblEnv
+        { ds_mod     :: Module                  -- For SCC profiling
+        , ds_unqual  :: PrintUnqualified
+        , ds_msgs    :: IORef Messages          -- Warning messages
+        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global, 
                                                 -- possibly-imported things
-        ds_dph_env :: GlobalRdrEnv              -- exported entities of 'Data.Array.Parallel.Prim' iff
-                                                -- '-fdph-*' flag was given (i.e., 'DynFlags.DPHBackend /=
-                                                -- DPHNone'); otherwise, empty
-    }
+        , ds_dph_env :: GlobalRdrEnv            -- exported entities of 'Data.Array.Parallel.Prim'
+                                                -- iff '-fvectorise' flag was given as well as
+                                                -- exported entities of 'Data.Array.Parallel' iff
+                                                -- '-XParallelArrays' was given; otherwise, empty
+        , ds_parr_bi :: PArrBuiltin             -- desugarar names for '-XParallelArrays'
+        }
 
 data DsLclEnv = DsLclEnv {
         ds_meta    :: DsMetaEnv,        -- Template Haskell bindings
@@ -171,8 +193,9 @@ initDs hsc_env mod rdr_env type_env thing_inside
               (ds_gbl_env, ds_lcl_env) = mkDsEnvs dflags mod rdr_env type_env msg_var
 
         ; either_res <- initTcRnIf 'd' hsc_env ds_gbl_env ds_lcl_env $
-                          loadDAPP dflags $
-                            tryM thing_inside       -- Catch exceptions (= errors during desugaring)
+                          loadDAP dflags $
+                            initDPHBuiltins $
+                              tryM thing_inside     -- Catch exceptions (= errors during desugaring)
 
         -- Display any errors and warnings 
         -- Note: if -Werror is used, we don't signal an error here.
@@ -190,22 +213,50 @@ initDs hsc_env mod rdr_env type_env thing_inside
         }
   where
     -- Extend the global environment with a 'GlobalRdrEnv' containing the exported entities of
-    -- 'Data.Array.Parallel.Prim' if '-fdph-*' specified.
-    loadDAPP dflags thing_inside
-      | Just pkg <- dphPackageMaybe dflags
-      = do { rdr_env <- loadModule sdoc (dATA_ARRAY_PARALLEL_PRIM pkg)
-           ; updGblEnv (\env -> env {ds_dph_env = rdr_env}) thing_inside
+    --   * 'Data.Array.Parallel'      iff '-XParallalArrays' specified (see also 'checkLoadDAP').
+    --   * 'Data.Array.Parallel.Prim' iff '-fvectorise' specified.
+    loadDAP dflags thing_inside
+      = do { dapEnv  <- loadOneModule dATA_ARRAY_PARALLEL_NAME      checkLoadDAP          paErr
+           ; dappEnv <- loadOneModule dATA_ARRAY_PARALLEL_PRIM_NAME (doptM Opt_Vectorise) veErr
+           ; updGblEnv (\env -> env {ds_dph_env = dapEnv `plusOccEnv` dappEnv }) thing_inside
            }
-      | otherwise
-      = do { ifXOptM Opt_ParallelArrays (liftIO $ fatalErrorMsg dflags $ ptext selectBackendErrPA)
-           ; ifDOptM Opt_Vectorise      (liftIO $ fatalErrorMsg dflags $ ptext selectBackendErrVect)
-           ; thing_inside
+      where
+        loadOneModule :: ModuleName           -- the module to load
+                      -> DsM Bool             -- under which condition
+                      -> Message              -- error message if module not found
+                      -> DsM GlobalRdrEnv     -- empty if condition 'False'
+        loadOneModule modname check err
+          = do { doLoad <- check
+               ; if not doLoad 
+                 then return emptyGlobalRdrEnv
+                 else do {
+               ; result <- liftIO $ findImportedModule hsc_env modname Nothing
+               ; case result of
+                   Found _ mod -> loadModule err mod
+                   _           -> do { liftIO $ fatalErrorMsg dflags err
+                                     ; panic "DsMonad.initDs: failed to load module"
+                                     }
+               } }
+
+        paErr = ptext $ sLit "To use -XParallelArrays, you must specify a DPH backend package"
+        veErr = ptext $ sLit "To use -fvectorise, you must specify a DPH backend package"
+
+    initDPHBuiltins thing_inside
+      = do {   -- If '-XParallelArrays' given, we populate the builtin table for desugaring those
+           ; doInitBuiltins <- checkLoadDAP
+           ; if doInitBuiltins
+             then dsInitPArrBuiltin thing_inside
+             else thing_inside
            }
 
-    sdoc = ptext (sLit "Internal Data Parallel Haskell interface 'Data.Array.Parallel.Prim'")
-
-    selectBackendErrVect = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
-    selectBackendErrPA   = sLit "To use -XParallelArrays select a DPH backend with -fdph-par or -fdph-seq"
+    checkLoadDAP = do { paEnabled <- xoptM Opt_ParallelArrays
+                      ; return $ paEnabled &&
+                                 mod /= gHC_PARR' && 
+                                 moduleName mod /= dATA_ARRAY_PARALLEL_NAME
+                      }
+                      -- do not load 'Data.Array.Parallel' iff compiling 'base:GHC.PArr' or a
+                      -- module called 'dATA_ARRAY_PARALLEL_NAME'; see also the comments at the top
+                      -- of 'base:GHC.PArr' and 'Data.Array.Parallel' in the DPH libraries
 
 initDsTc :: DsM a -> TcM a
 initDsTc thing_inside
@@ -228,23 +279,26 @@ mkDsEnvs dflags mod rdr_env type_env msg_var
                            , ds_unqual  = mkPrintUnqualified dflags rdr_env
                            , ds_msgs    = msg_var
                            , ds_dph_env = emptyGlobalRdrEnv
+                           , ds_parr_bi = panic "DsMonad: uninitialised ds_parr_bi"
                            }
         lcl_env = DsLclEnv { ds_meta = emptyNameEnv
                            , ds_loc  = noSrcSpan
                            }
     in (gbl_env, lcl_env)
 
--- Attempt to load the given module and return its exported entities if successful; otherwise, return an
--- empty environment.  See "Note [Loading Data.Array.Parallel.Prim]".
+-- Attempt to load the given module and return its exported entities if successful.
 --
 loadModule :: SDoc -> Module -> DsM GlobalRdrEnv
 loadModule doc mod
-  = do { env <- getGblEnv
+  = do { env    <- getGblEnv
+       ; dflags <- getDOpts
        ; setEnvs (ds_if_env env) $ do
        { iface <- loadInterface doc mod ImportBySystem
-       ;   case iface of
-             Failed _err     -> return $ mkGlobalRdrEnv []
-             Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface
+       ; case iface of
+           Failed err      -> do { liftIO $ fatalErrorMsg dflags (err $$ doc)
+                                 ; panic "DsMonad.loadModule: failed to load"
+                                 }
+           Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface
        } }
   where
     prov     = Imported [ImpSpec { is_decl = imp_spec, is_item = ImpAll }]
@@ -253,15 +307,6 @@ loadModule doc mod
     name = moduleName mod
 \end{code}
 
-Note [Loading Data.Array.Parallel.Prim]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We generally attempt to load the interface of 'Data.Array.Parallel.Prim' when a DPH backend is selected.
-However, while compiling packages containing a DPH backend, we will start out compiling the modules
-'Data.Array.Parallel.Prim' depends on — i.e., when compiling these modules, the interface won't exist yet.
-This is fine, as these modules do not use the vectoriser, but we need to ensure that GHC doesn't barf when
-the interface is missing.  Instead of an error message, we just put an empty 'GlobalRdrEnv' into the
-'DsM' state.
-
 
 %************************************************************************
 %*                                                                      *
@@ -355,18 +400,11 @@ dsLookupGlobalId :: Name -> DsM Id
 dsLookupGlobalId name 
   = tyThingId <$> dsLookupGlobal name
 
--- Looking up a global DPH 'Id' is like 'dsLookupGlobalId', but the package, in which the looked
--- up name is located, varies with the active DPH backend.
+-- |Get a name from "Data.Array.Parallel" for the desugarer, from the 'ds_parr_bi' component of the
+-- global desugerar environment.
 --
-dsLookupDPHId :: (PackageId -> Name) -> DsM Id
-dsLookupDPHId nameInPkg
-  = do { dflags <- getDOpts
-       ; case dphPackageMaybe dflags of
-           Just pkg -> tyThingId <$> dsLookupGlobal (nameInPkg pkg)
-           Nothing  -> failWithDs $ ptext err
-       }
-  where
-    err = sLit "To use -XParallelArrays select a DPH backend with -fdph-par or -fdph-seq"
+dsDPHBuiltin :: (PArrBuiltin -> a) -> DsM a
+dsDPHBuiltin sel = (sel . ds_parr_bi) <$> getGblEnv
 
 dsLookupTyCon :: Name -> DsM TyCon
 dsLookupTyCon name
@@ -378,28 +416,61 @@ dsLookupDataCon name
 \end{code}
 
 \begin{code}
--- Complain if 'Data.Array.Parallel.Prim' wasn't loaded (and we are about to use it).
---
--- See "Note [Loading Data.Array.Parallel.Prim]".
+-- Look up a name exported by 'Data.Array.Parallel.Prim' or 'Data.Array.Parallel.Prim'.
 --
-assertDAPPLoaded :: DsM ()
-assertDAPPLoaded 
-  = do { env <- ds_dph_env <$> getGblEnv
-       ; when (null $ occEnvElts env) $
-           panic "'Data.Array.Parallel.Prim' not available; maybe missing dependency in DPH package"
-       }
-
--- Look up a name exported by 'Data.Array.Parallel.Prim'.
---
-lookupDAPPRdrEnv :: OccName -> DsM Name
-lookupDAPPRdrEnv occ
+dsLookupDPHRdrEnv :: OccName -> DsM Name
+dsLookupDPHRdrEnv occ
   = do { env <- ds_dph_env <$> getGblEnv
        ; let gres = lookupGlobalRdrEnv env occ
        ; case gres of
-           []    -> pprPanic "Name not found in 'Data.Array.Parallel.Prim':" (ppr occ)
+           []    -> pprPanic nameNotFound (ppr occ)
            [gre] -> return $ gre_name gre
-           _     -> pprPanic "Multiple definitions in 'Data.Array.Parallel.Prim':" (ppr occ)
+           _     -> pprPanic multipleNames (ppr occ)
        }
+  where
+    nameNotFound  = "Name not found in 'Data.Array.Parallel' or 'Data.Array.Parallel.Prim':"
+    multipleNames = "Multiple definitions in 'Data.Array.Parallel' and 'Data.Array.Parallel.Prim':"
+
+-- Populate 'ds_parr_bi' from 'ds_dph_env'.
+--
+dsInitPArrBuiltin :: DsM a -> DsM a
+dsInitPArrBuiltin thing_inside
+  = do { lengthPVar         <- externalVar (fsLit "lengthP")
+       ; replicatePVar      <- externalVar (fsLit "replicateP")
+       ; singletonPVar      <- externalVar (fsLit "singletonP")
+       ; mapPVar            <- externalVar (fsLit "mapP")
+       ; filterPVar         <- externalVar (fsLit "filterP")
+       ; zipPVar            <- externalVar (fsLit "zipP")
+       ; crossMapPVar       <- externalVar (fsLit "crossMapP")
+       ; indexPVar          <- externalVar (fsLit "!:")
+       ; emptyPVar          <- externalVar (fsLit "emptyP")
+       ; appPVar            <- externalVar (fsLit "+:+")
+       -- ; enumFromToPVar     <- externalVar (fsLit "enumFromToP")
+       -- ; enumFromThenToPVar <- externalVar (fsLit "enumFromThenToP")
+       ; enumFromToPVar     <- return arithErr
+       ; enumFromThenToPVar <- return arithErr
+
+       ; updGblEnv (\env -> env {ds_parr_bi = PArrBuiltin
+                                              { lengthPVar         = lengthPVar
+                                              , replicatePVar      = replicatePVar
+                                              , singletonPVar      = singletonPVar
+                                              , mapPVar            = mapPVar
+                                              , filterPVar         = filterPVar
+                                              , zipPVar            = zipPVar
+                                              , crossMapPVar       = crossMapPVar
+                                              , indexPVar          = indexPVar
+                                              , emptyPVar          = emptyPVar
+                                              , appPVar            = appPVar
+                                              , enumFromToPVar     = enumFromToPVar
+                                              , enumFromThenToPVar = enumFromThenToPVar
+                                              } })
+                   thing_inside
+       }
+  where
+    externalVar :: FastString -> DsM Var
+    externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
+    
+    arithErr = panic "Arithmetic sequences have to wait until we support type classes"
 \end{code}
 
 \begin{code}

compiler/deSugar/DsUtils.lhs

@@ -389,7 +389,7 @@ mkCoAlgCaseMatchResult var ty match_alts
     isPArrFakeAlts [] = panic "DsUtils: unexpectedly found an empty list of PArr fake alternatives"
     --
     mk_parrCase fail = do
-      lengthP <- dsLookupDPHId lengthPName
+      lengthP <- dsDPHBuiltin lengthPVar
       alt <- unboxAlt
       return (mkWildCase (len lengthP) intTy ty [alt])
       where
@@ -401,7 +401,7 @@ mkCoAlgCaseMatchResult var ty match_alts
 	--
 	unboxAlt = do
 	  l      <- newSysLocalDs intPrimTy
-	  indexP <- dsLookupDPHId indexPName
+	  indexP <- dsDPHBuiltin indexPVar
 	  alts   <- mapM (mkAlt indexP) sorted_alts
 	  return (DataAlt intDataCon, [l], mkWildCase (Var l) intPrimTy ty (dft : alts))
           where

compiler/main/Packages.lhs

@@ -727,8 +727,8 @@ mkPackageState dflags pkgs0 preload0 this_package = do
       flags = reverse (packageFlags dflags) ++ dphPackage
       -- expose the appropriate DPH backend library
       dphPackage = case dphBackend dflags of
-                     DPHPar  -> [ExposePackage "dph-prim-par", ExposePackage "dph-par"]
-                     DPHSeq  -> [ExposePackage "dph-prim-seq", ExposePackage "dph-seq"]
+                     DPHPar  -> [ExposePackage "dph-par"]
+                     DPHSeq  -> [ExposePackage "dph-seq"]
                      DPHThis -> []
                      DPHNone -> []
 

compiler/prelude/PrelNames.lhs

@@ -156,7 +156,6 @@ basicKnownKeyNames :: [Name]
 basicKnownKeyNames
  = genericTyConNames
  ++ typeableClassNames
- ++ dphKnownKeyNames dphSeqPackageId ++ dphKnownKeyNames dphParPackageId
  ++ [   -- Type constructors (synonyms especially)
         ioTyConName, ioDataConName,
         runMainIOName,
@@ -306,20 +305,6 @@ genericTyConNames = [
     d1TyConName, c1TyConName, s1TyConName, noSelTyConName,
     repTyConName, rep1TyConName
   ]
-
--- Know names from the DPH package which vary depending on the selected DPH backend.
---
-dphKnownKeyNames :: PackageId -> [Name]
-dphKnownKeyNames dphPkg
-  = map ($ dphPkg)
-    [
-        -- Parallel array operations
-          nullPName, lengthPName, replicatePName,       singletonPName, mapPName,
-          filterPName, zipPName, crossMapPName, indexPName,
-          toPName, emptyPName, appPName,
-        enumFromToPName, enumFromThenToPName
-
-    ]
 \end{code}
 
 
@@ -399,12 +384,6 @@ rANDOM          = mkBaseModule (fsLit "System.Random")
 gHC_EXTS        = mkBaseModule (fsLit "GHC.Exts")
 cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
 
-dATA_ARRAY_PARALLEL_PRIM :: PackageId -> Module
-dATA_ARRAY_PARALLEL_PRIM pkg = mkModule pkg (mkModuleNameFS (fsLit "Data.Array.Parallel.Prim"))
-
-gHC_PARR :: PackageId -> Module
-gHC_PARR pkg = mkModule pkg (mkModuleNameFS (fsLit "Data.Array.Parallel"))
-
 gHC_PARR' :: Module
 gHC_PARR' = mkBaseModule (fsLit "GHC.PArr")
 
@@ -423,6 +402,10 @@ pRELUDE_NAME, mAIN_NAME :: ModuleName
 pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
 mAIN_NAME      = mkModuleNameFS (fsLit "Main")
 
+dATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName
+dATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit "Data.Array.Parallel")
+dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim")
+
 mkPrimModule :: FastString -> Module
 mkPrimModule m = mkModule primPackageId (mkModuleNameFS m)
 
@@ -964,26 +947,6 @@ datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey
 constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
 selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey
 
--- parallel array types and functions
-enumFromToPName, enumFromThenToPName, nullPName, lengthPName,
-    singletonPName, replicatePName, mapPName, filterPName,
-    zipPName, crossMapPName, indexPName, toPName,
-    emptyPName, appPName :: PackageId -> Name
-enumFromToPName     pkg = varQual (gHC_PARR pkg) (fsLit "enumFromToP")     enumFromToPIdKey
-enumFromThenToPName pkg = varQual (gHC_PARR pkg) (fsLit "enumFromThenToP") enumFromThenToPIdKey
-nullPName           pkg = varQual (gHC_PARR pkg) (fsLit "nullP")           nullPIdKey
-lengthPName         pkg = varQual (gHC_PARR pkg) (fsLit "lengthP")         lengthPIdKey
-singletonPName      pkg = varQual (gHC_PARR pkg) (fsLit "singletonP")      singletonPIdKey
-replicatePName      pkg = varQual (gHC_PARR pkg) (fsLit "replicateP")      replicatePIdKey
-mapPName            pkg = varQual (gHC_PARR pkg) (fsLit "mapP")            mapPIdKey
-filterPName         pkg = varQual (gHC_PARR pkg) (fsLit "filterP")         filterPIdKey
-zipPName            pkg = varQual (gHC_PARR pkg) (fsLit "zipP")            zipPIdKey
-crossMapPName       pkg = varQual (gHC_PARR pkg) (fsLit "crossMapP")       crossMapPIdKey
-indexPName          pkg = varQual (gHC_PARR pkg) (fsLit "!:")              indexPIdKey
-toPName             pkg = varQual (gHC_PARR pkg) (fsLit "toP")             toPIdKey
-emptyPName          pkg = varQual (gHC_PARR pkg) (fsLit "emptyP")          emptyPIdKey
-appPName            pkg = varQual (gHC_PARR pkg) (fsLit "+:+")             appPIdKey
-
 -- IO things
 ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
     failIOName :: Name
@@ -1539,25 +1502,6 @@ dollarIdKey           = mkPreludeMiscIdUnique 123
 coercionTokenIdKey :: Unique
 coercionTokenIdKey    = mkPreludeMiscIdUnique 124
 
--- Parallel array functions
-singletonPIdKey, nullPIdKey, lengthPIdKey, replicatePIdKey, mapPIdKey,
-    filterPIdKey, zipPIdKey, crossMapPIdKey, indexPIdKey, toPIdKey,
-    enumFromToPIdKey, enumFromThenToPIdKey, emptyPIdKey, appPIdKey :: Unique
-singletonPIdKey               = mkPreludeMiscIdUnique 130
-nullPIdKey                    = mkPreludeMiscIdUnique 131
-lengthPIdKey                  = mkPreludeMiscIdUnique 132
-replicatePIdKey               = mkPreludeMiscIdUnique 133
-mapPIdKey                     = mkPreludeMiscIdUnique 134
-filterPIdKey                  = mkPreludeMiscIdUnique 135
-zipPIdKey                     = mkPreludeMiscIdUnique 136
-crossMapPIdKey                = mkPreludeMiscIdUnique 137
-indexPIdKey                   = mkPreludeMiscIdUnique 138
-toPIdKey                      = mkPreludeMiscIdUnique 139
-enumFromToPIdKey              = mkPreludeMiscIdUnique 140
-enumFromThenToPIdKey          = mkPreludeMiscIdUnique 141
-emptyPIdKey                   = mkPreludeMiscIdUnique 142
-appPIdKey                     = mkPreludeMiscIdUnique 143
-
 -- dotnet interop
 unmarshalObjectIdKey, marshalObjectIdKey, marshalStringIdKey,
     unmarshalStringIdKey, checkDotnetResNameIdKey :: Unique

compiler/typecheck/TcExpr.lhs

@@ -39,6 +39,7 @@ import TcHsType
 import TcPat
 import TcMType
 import TcType
+import DsMonad hiding (Splice)
 import Id
 import DataCon
 import Name
@@ -52,7 +53,6 @@ import TysWiredIn
 import TysPrim( intPrimTy )
 import PrimOp( tagToEnumKey )
 import PrelNames
-import Module
 import DynFlags
 import SrcLoc
 import Util
@@ -749,8 +749,9 @@ tcExpr (PArrSeq _ seq@(FromTo expr1 expr2)) res_ty
   = do	{ (coi, elt_ty) <- matchExpectedPArrTy res_ty
 	; expr1' <- tcPolyExpr expr1 elt_ty
 	; expr2' <- tcPolyExpr expr2 elt_ty
+	; enumFromToP <- initDsTc $ dsDPHBuiltin enumFromToPVar
 	; enum_from_to <- newMethodFromName (PArrSeqOrigin seq) 
-				 (enumFromToPName basePackageId) elt_ty    -- !!!FIXME: chak
+				 (idName enumFromToP) elt_ty
 	; return $ mkHsWrapCo coi 
                      (PArrSeq enum_from_to (FromTo expr1' expr2')) }
 
@@ -759,13 +760,14 @@ tcExpr (PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
 	; expr1' <- tcPolyExpr expr1 elt_ty
 	; expr2' <- tcPolyExpr expr2 elt_ty
 	; expr3' <- tcPolyExpr expr3 elt_ty
+	; enumFromThenToP <- initDsTc $ dsDPHBuiltin enumFromThenToPVar
 	; eft <- newMethodFromName (PArrSeqOrigin seq)
-		      (enumFromThenToPName basePackageId) elt_ty        -- !!!FIXME: chak
+		      (idName enumFromThenToP) elt_ty        -- !!!FIXME: chak
 	; return $ mkHsWrapCo coi 
                      (PArrSeq eft (FromThenTo expr1' expr2' expr3')) }
 
 tcExpr (PArrSeq _ _) _ 
-  = panic "TcExpr.tcMonoExpr: Infinite parallel array!"
+  = panic "TcExpr.tcExpr: Infinite parallel array!"
     -- the parser shouldn't have generated it and the renamer shouldn't have
     -- let it through
 \end{code}

compiler/vectorise/Vectorise/Builtins/Initialise.hs

@@ -30,9 +30,7 @@ import Data.Array
 --
 initBuiltins :: DsM Builtins
 initBuiltins
- = do { assertDAPPLoaded      -- complain if 'Data.Array.Parallel.Prim' is not available
-
-          -- 'PArray': desugared array type
+ = do {   -- 'PArray': desugared array type
       ; parrayTyCon <- externalTyCon (fsLit "PArray")
       ; parray_tcs  <- mapM externalTyCon (suffixed "PArray" aLL_DPH_PRIM_TYCONS)
       ; let parray_PrimTyCons = mkNameEnv (zip aLL_DPH_PRIM_TYCONS parray_tcs)
@@ -206,19 +204,19 @@ initBuiltinTyCons bi
 -- Lookup a variable given its name and the module that contains it.
 --
 externalVar :: FastString -> DsM Var
-externalVar fs = lookupDAPPRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
+externalVar fs = dsLookupDPHRdrEnv (mkVarOccFS fs) >>= dsLookupGlobalId
 
 -- Like `externalVar` but wrap the `Var` in a `CoreExpr`.
 --
 externalFun :: FastString -> DsM CoreExpr
-externalFun fs = liftM Var $ externalVar fs
+externalFun fs = Var <$> externalVar fs
 
 -- Lookup a 'TyCon' in 'Data.Array.Parallel.Prim', given its name.
 --
 externalTyCon :: FastString -> DsM TyCon
-externalTyCon fs = lookupDAPPRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon
+externalTyCon fs = dsLookupDPHRdrEnv (mkTcOccFS fs) >>= dsLookupTyCon
 
--- Lookup some `Type` given its name and the module that contains it.
+-- Lookup some `Type` in 'Data.Array.Parallel.Prim', given its name.
 --
 externalType :: FastString -> DsM Type
 externalType fs
@@ -229,7 +227,7 @@ externalType fs
 --
 externalClass :: FastString -> DsM Class
 externalClass fs 
-  = do { tycon <- lookupDAPPRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon
+  = do { tycon <- dsLookupDPHRdrEnv (mkClsOccFS fs) >>= dsLookupTyCon
        ; case tyConClass_maybe tycon of
            Nothing  -> pprPanic "Vectorise.Builtins.Initialise" $ 
                          ptext (sLit "Data.Array.Parallel.Prim.") <>