X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=5e265e85994d7ca2e63c07a81f3d3708aef09df0;hb=cf5905ea24904cf73a041fd7535e8723a668cb9a;hp=ec46a43bc1d08c2ee854c6f9b8376dc4e34f80e6;hpb=5e54b553bbb112167412ee9164135d56b06f5721;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index ec46a43..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, @@ -622,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 @@ -666,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 @@ -750,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 @@ -879,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