Use lookupOrig to find built-in NDP-related names

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index d2439ad..5602a6c 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -276,6 +276,7 @@ gLA_EXTS    = mkBaseModule FSLIT("GHC.Exts")
 nDP_PARRAY      = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.PArray")
 nDP_UTILS       = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Utils")
 nDP_CLOSURE     = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Closure")
+nDP_INSTANCES   = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Instances")
 
 mAIN           = mkMainModule_ mAIN_NAME
 rOOT_MAIN      = mkMainModule FSLIT(":Main") -- Root module for initialisation 

diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 7bd7538..9a680e7 100644 (file)
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -21,7 +21,7 @@ module VectMonad (
   lookupVar, defGlobalVar,
   lookupTyCon, defTyCon,
   lookupDataCon, defDataCon,
-  lookupTyConPA, defTyConPA, defTyConPAs, defTyConRdrPAs,
+  lookupTyConPA, defTyConPA, defTyConPAs, defTyConBuiltinPAs,
   lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
 
   {-lookupInst,-} lookupFamInst
@@ -41,7 +41,8 @@ import OccName
 import Name
 import NameEnv
 import TysPrim       ( intPrimTy )
-import RdrName
+import Module
+import IfaceEnv
 
 import DsMonad
 import PrelNames
@@ -54,7 +55,7 @@ import Outputable
 import FastString
 import SrcLoc        ( noSrcSpan )
 
-import Control.Monad ( liftM )
+import Control.Monad ( liftM, zipWithM )
 
 data Scope a b = Global a | Local b
 
@@ -154,10 +155,6 @@ data GlobalEnv = GlobalEnv {
 
                 -- Hoisted bindings
                 , global_bindings :: [(Var, CoreExpr)]
-
-                  -- Global Rdr environment (from ModGuts)
-                  --
-                , global_rdr_env :: GlobalRdrEnv
                 }
 
 data LocalEnv = LocalEnv {
@@ -178,9 +175,9 @@ data LocalEnv = LocalEnv {
                }
               
 
-initGlobalEnv :: VectInfo -> (InstEnv, InstEnv) -> FamInstEnvs -> Builtins -> GlobalRdrEnv
+initGlobalEnv :: VectInfo -> (InstEnv, InstEnv) -> FamInstEnvs -> Builtins
               -> GlobalEnv
-initGlobalEnv info instEnvs famInstEnvs bi rdr_env
+initGlobalEnv info instEnvs famInstEnvs bi
   = GlobalEnv {
       global_vars          = mapVarEnv snd $ vectInfoVar info
     , global_exported_vars = emptyVarEnv
@@ -192,7 +189,6 @@ initGlobalEnv info instEnvs famInstEnvs bi rdr_env
     , global_inst_env      = instEnvs
     , global_fam_inst_env  = famInstEnvs
     , global_bindings      = []
-    , global_rdr_env       = rdr_env
     }
 
 setFamInstEnv :: FamInstEnv -> GlobalEnv -> GlobalEnv
@@ -316,20 +312,10 @@ inBind id p
   = do updLEnv $ \env -> env { local_bind_name = occNameFS (getOccName id) }
        p
 
-lookupRdrName :: RdrName -> VM Name
-lookupRdrName rdr_name
-  = do
-      rdr_env <- readGEnv global_rdr_env
-      case lookupGRE_RdrName rdr_name rdr_env of
-        [gre] -> return (gre_name gre)
-        []    -> pprPanic "VectMonad.lookupRdrName: not found" (ppr rdr_name)
-        _     -> pprPanic "VectMonad.lookupRdrName: ambiguous" (ppr rdr_name)
-
-lookupRdrVar :: RdrName -> VM Var
-lookupRdrVar rdr_name
-  = do
-      name <- lookupRdrName rdr_name
-      liftDs (dsLookupGlobalId name)
+lookupExternalVar :: Module -> FastString -> VM Var
+lookupExternalVar mod fs
+  = liftDs
+  $ dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
 
 cloneName :: (OccName -> OccName) -> Name -> VM Name
 cloneName mk_occ name = liftM make (liftDs newUnique)
@@ -422,15 +408,15 @@ defTyConPAs ps = updGEnv $ \env ->
   env { global_pa_funs = extendNameEnvList (global_pa_funs env)
                                            [(tyConName tc, pa) | (tc, pa) <- ps] }
 
-defTyConRdrPAs :: [(Name, RdrName)] -> VM ()
-defTyConRdrPAs ps
+defTyConBuiltinPAs :: [(Name, Module, FastString)] -> VM ()
+defTyConBuiltinPAs ps
   = do
-      pas <- mapM lookupRdrVar rdr_names
+      pas <- zipWithM lookupExternalVar mods fss
       updGEnv $ \env ->
         env { global_pa_funs = extendNameEnvList (global_pa_funs env)
                                                  (zip tcs pas) }
   where
-    (tcs, rdr_names) = unzip ps
+    (tcs, mods, fss) = unzip3 ps
 
 lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
 lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv 
@@ -525,8 +511,7 @@ initV hsc_env guts info p
         r <- runVM p builtins (initGlobalEnv info
                                              instEnvs
                                              famInstEnvs
-                                             builtins
-                                             (mg_rdr_env guts))
+                                             builtins)
                    emptyLocalEnv
         case r of
           Yes genv _ x -> return $ Just (new_info genv, x)

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 03fa131..d074092 100644 (file)
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -30,8 +30,7 @@ import NameEnv
 import Id
 import MkId                 ( unwrapFamInstScrut )
 import OccName
-import RdrName              ( RdrName, mkRdrQual )
-import Module               ( mkModuleNameFS )
+import Module               ( Module )
 
 import DsMonad hiding (mapAndUnzipM)
 import DsUtils              ( mkCoreTup, mkCoreTupTy )
@@ -46,23 +45,18 @@ import Outputable
 import FastString
 import Control.Monad        ( liftM, liftM2, zipWithM, mapAndUnzipM )
 
-mkNDPVar :: String -> RdrName
-mkNDPVar s = mkRdrQual nDP_BUILTIN (mkVarOcc s)
-
-mkNDPVarFS :: FastString -> RdrName
-mkNDPVarFS fs = mkRdrQual nDP_BUILTIN (mkVarOccFS fs)
-
-builtin_PAs :: [(Name, RdrName)]
+builtin_PAs :: [(Name, Module, FastString)]
 builtin_PAs = [
                 mk closureTyConName FSLIT("dPA_Clo")
               , mk intTyConName     FSLIT("dPA_Int")
               ]
               ++ tups
   where
-    mk name fs = (name, mkNDPVarFS fs)
+    mk name fs = (name, nDP_INSTANCES, fs)
 
     tups = mk_tup 0 : map mk_tup [2..3]
-    mk_tup n   = (getName $ tupleTyCon Boxed n, mkNDPVar $ "dPA_" ++ show n)
+    mk_tup n   = (getName $ tupleTyCon Boxed n, nDP_INSTANCES,
+                  mkFastString $ "dPA_" ++ show n)
 
 vectorise :: HscEnv -> UniqSupply -> RuleBase -> ModGuts
           -> IO (SimplCount, ModGuts)
@@ -80,7 +74,7 @@ vectorise hsc_env _ _ guts
 vectModule :: ModGuts -> VM ModGuts
 vectModule guts
   = do
-      defTyConRdrPAs builtin_PAs
+      defTyConBuiltinPAs builtin_PAs
       (types', fam_insts, tc_binds) <- vectTypeEnv (mg_types guts)
       
       let fam_inst_env' = extendFamInstEnvList (mg_fam_inst_env guts) fam_insts