X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=5e265e85994d7ca2e63c07a81f3d3708aef09df0;hp=a940f991211ae07f3b39eabb66bde41b5674cce7;hb=02fa8eafaae87b1d2e8b6f1f34b7d6b1af1da58f;hpb=e95ee1f718c6915c478005aad8af81705357d6ab

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index a940f99..5e265e8 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -14,7 +14,7 @@ module Packages (
 	PackageState(..),
 	initPackages,
 	getPackageDetails,
-	lookupModuleInAllPackages,
+        lookupModuleInAllPackages, lookupModuleWithSuggestions,
 
 	-- * Inspecting the set of packages in scope
 	getPackageIncludePath,
@@ -36,7 +36,7 @@ where
 #include "HsVersions.h"
 
 import PackageConfig	
-import DynFlags		( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
+import DynFlags		( dopt, DynFlag(..), DynFlags(..), PackageFlag(..), DPHBackend(..) )
 import StaticFlags
 import Config		( cProjectVersion )
 import Name		( Name, nameModule_maybe )
@@ -170,7 +170,7 @@ initPackages :: DynFlags -> IO (DynFlags, [PackageId])
 initPackages dflags = do 
   pkg_db <- case pkgDatabase dflags of
                 Nothing -> readPackageConfigs dflags
-                Just db -> return db
+                Just db -> return $ maybeHidePackages dflags db
   (pkg_state, preload, this_pkg)       
         <- mkPackageState dflags pkg_db [] (thisPackage dflags)
   return (dflags{ pkgDatabase = Just pkg_db,
@@ -359,6 +359,15 @@ comparing f a b = f a `compare` f b
 packageFlagErr :: PackageFlag
                -> [(PackageConfig, UnusablePackageReason)]
                -> IO a
+
+-- for missing DPH package we emit a more helpful error message, because
+-- this may be the result of using -fdph-par or -fdph-seq.
+packageFlagErr (ExposePackage pkg) [] | is_dph_package pkg
+  = ghcError (CmdLineError (showSDoc $ dph_err))
+  where dph_err = text "the " <> text pkg <> text " package is not installed."
+                  $$ text "To install it: \"cabal install dph\"."
+        is_dph_package pkg = "dph" `isPrefixOf` pkg
+  
 packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
   where err = text "cannot satisfy " <> ppr_flag <> 
                 (if null reasons then empty else text ": ") $$
@@ -419,7 +428,6 @@ findWiredInPackages dflags pkgs = do
                             integerPackageId,
                             basePackageId,
                             rtsPackageId,
-                            haskell98PackageId,
                             thPackageId,
                             dphSeqPackageId,
                             dphParPackageId ]
@@ -614,7 +622,6 @@ mkPackageState
     -> IO (PackageState,
            [PackageId],         -- new packages to preload
            PackageId) -- this package, might be modified if the current
-
                       -- package is a wired-in package.
 
 mkPackageState dflags pkgs0 preload0 this_package = do
@@ -658,7 +665,13 @@ mkPackageState dflags pkgs0 preload0 this_package = do
 -}
 
   let
-      flags = reverse (packageFlags dflags)
+      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"]
+                     DPHThis -> []
+                     DPHNone -> []
 
       -- pkgs0 with duplicate packages filtered out.  This is
       -- important: it is possible for a package in the global package
@@ -742,19 +755,19 @@ mkPackageState dflags pkgs0 preload0 this_package = do
       -- set up preloaded package when we are just building it
       preload3 = nub $ filter (/= this_package)
                      $ (basicLinkedPackages ++ preload2)
-
+ 
   -- Close the preload packages with their dependencies
   dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
   let new_dep_preload = filter (`notElem` preload0) dep_preload
 
   let pstate = PackageState{ preloadPackages     = dep_preload,
-		             pkgIdMap   	 = pkg_db,
-		             moduleToPkgConfAll  = mkModuleMap pkg_db,
+                             pkgIdMap            = pkg_db,
+                             moduleToPkgConfAll  = mkModuleMap pkg_db,
                              installedPackageIdMap = ipid_map
-		           }
+                           }
 
   return (pstate, new_dep_preload, this_package)
-
+  
 
 -- -----------------------------------------------------------------------------
 -- Make the mapping from module to package info
@@ -871,10 +884,32 @@ getPackageFrameworks dflags pkgs = do
 -- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
 -- and exposed is @True@ if the package exposes the module.
 lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
-lookupModuleInAllPackages dflags m =
-  case lookupUFM (moduleToPkgConfAll (pkgState dflags)) m of
-	Nothing -> []
-	Just ps -> ps
+lookupModuleInAllPackages dflags m
+  = case lookupModuleWithSuggestions dflags m of
+      Right pbs -> pbs
+      Left  _   -> []
+
+lookupModuleWithSuggestions
+  :: DynFlags -> ModuleName
+  -> Either [Module] [(PackageConfig,Bool)]
+         -- Lookup module in all packages
+         -- Right pbs   =>   found in pbs
+         -- Left  ms    =>   not found; but here are sugestions
+lookupModuleWithSuggestions dflags m
+  = case lookupUFM (moduleToPkgConfAll pkg_state) m of
+        Nothing -> Left suggestions
+        Just ps -> Right ps
+  where
+    pkg_state = pkgState dflags
+    suggestions
+      | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods
+      | otherwise                     = []
+
+    all_mods :: [(String, Module)]     -- All modules
+    all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
+               | pkg_config <- eltsUFM (pkgIdMap pkg_state)
+               , let pkg_id = packageConfigId pkg_config
+               , mod_nm <- exposedModules pkg_config ]
 
 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
 -- 'PackageConfig's
@@ -947,6 +982,9 @@ missingDependencyMsg (Just parent)
 
 -- | Will the 'Name' come from a dynamically linked library?
 isDllName :: PackageId -> Name -> Bool
+-- Despite the "dll", I think this function just means that
+-- the synbol comes from another dynamically-linked package,
+-- and applies on all platforms, not just Windows
 isDllName this_pkg name
   | opt_Static = False
   | Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg