X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=d5cfbd10986ef08622eb346ecd4810a6c3f2ae68;hb=7eb5e29b4a7b6fef55512bc7bf3308e712ca3eba;hp=9904fdf609a82fb1d5348dec94d330c566d0dd30;hpb=d5b1999089dd4a45cf872f88dd0d49e1207a3161;p=ghc-hetmet.git

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 9904fdf..d5cfbd1 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -66,6 +66,7 @@ import FastString
 import ErrUtils         ( debugTraceMsg, putMsg, Message )
 
 import System.Directory
+import System.FilePath
 import Data.Maybe
 import Control.Monad
 import Data.List
@@ -210,14 +211,14 @@ getSystemPackageConfigs dflags = do
 	-- to maintain the package database on systems with a package
 	-- management system, or systems that don't want to run ghc-pkg
 	-- to register or unregister packages.  Undocumented feature for now.
-   let system_pkgconf_dir = system_pkgconf ++ ".d"
+   let system_pkgconf_dir = system_pkgconf <.> "d"
    system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
    system_pkgconfs <-
      if system_pkgconf_dir_exists
        then do files <- getDirectoryContents system_pkgconf_dir
-               return [ system_pkgconf_dir ++ '/' : file
+               return [ system_pkgconf_dir </> file
                       | file <- files
-                      , isSuffixOf ".conf" file]
+                      , takeExtension file == ".conf" ]
        else return []
 
 	-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
@@ -228,8 +229,8 @@ getSystemPackageConfigs dflags = do
       appdir <- getAppUserDataDirectory "ghc"
       let 
      	 pkgconf = appdir
-		   `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
-		   `joinFileName` "package.conf"
+		   </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+		   </> "package.conf"
       flg <- doesFileExist pkgconf
       if (flg && dopt Opt_ReadUserPackageConf dflags)
 	then return [pkgconf]
@@ -268,9 +269,12 @@ mungePackagePaths top_dir ps = map munge_pkg ps
   munge_paths = map munge_path
 
   munge_path p 
-	  | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
+	  | Just p' <- maybePrefixMatch "$topdir"     p =            top_dir ++ p'
+	  | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
 	  | otherwise				    = p
 
+  toHttpPath p = "file:///" ++ p
+
 
 -- -----------------------------------------------------------------------------
 -- Modify our copy of the package database based on a package flag
@@ -557,12 +561,12 @@ mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
         
 	extend_modmap pkgid modmap =
 		addListToUFM_C (++) modmap 
-		    [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods]
+		   ([(m, [(pkg, True)])  | m <- exposed_mods] ++
+		    [(m, [(pkg, False)]) | m <- hidden_mods])
 	  where
 		pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
-	        exposed_mods = map mkModuleName (exposedModules pkg)
-	        hidden_mods  = map mkModuleName (hiddenModules pkg)
-		all_mods = exposed_mods ++ hidden_mods
+	        exposed_mods = exposedModules pkg
+	        hidden_mods  = hiddenModules pkg
 
 pprPkg :: PackageConfig -> SDoc
 pprPkg p = text (showPackageId (package p))
@@ -704,5 +708,10 @@ dumpPackages :: DynFlags -> IO ()
 dumpPackages dflags
   = do  let pkg_map = pkgIdMap (pkgState dflags)
 	putMsg dflags $
-	      vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map))
+	      vcat (map (text.showInstalledPackageInfo.to_ipi) (eltsUFM pkg_map))
+ where
+  to_ipi pkgconf@InstalledPackageInfo_{ exposedModules = e,
+                                        hiddenModules = h } = 
+    pkgconf{ exposedModules = map moduleNameString e,
+             hiddenModules  = map moduleNameString h }
 \end{code}