remove empty dir
[ghc-hetmet.git] / ghc / compiler / main / Packages.lhs
index 5f32acc..ae6b188 100644 (file)
@@ -61,19 +61,14 @@ import System.Directory     ( getAppUserDataDirectory )
 import Compat.Directory        ( getAppUserDataDirectory )
 #endif
 
+import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.Package
 import Distribution.Version
-import Data.Maybe      ( isNothing )
-import System.Directory        ( doesFileExist )
+import System.Directory        ( doesFileExist, doesDirectoryExist,
+                         getDirectoryContents )
 import Control.Monad   ( foldM )
-import Data.List       ( nub, partition, sortBy )
-
-#ifdef mingw32_TARGET_OS
-import Data.List       ( isPrefixOf )
-#endif
-import Data.List        ( isSuffixOf )
-
+import Data.List       ( nub, partition, sortBy, isSuffixOf )
 import FastString
 import EXCEPTION       ( throwDyn )
 import ErrUtils         ( debugTraceMsg, putMsg, Message )
@@ -207,33 +202,61 @@ initPackages dflags = do
 
 readPackageConfigs :: DynFlags -> IO PackageConfigMap
 readPackageConfigs dflags = do
+   e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
+   system_pkgconfs <- getSystemPackageConfigs dflags
+
+   let pkgconfs = case e_pkg_path of
+                   Left _   -> system_pkgconfs
+                   Right path
+                    | last cs == "" -> init cs ++ system_pkgconfs
+                    | otherwise     -> cs
+                    where cs = parseSearchPath path
+                    -- if the path ends in a separator (eg. "/foo/bar:")
+                    -- the we tack on the system paths.
+
+       -- Read all the ones mentioned in -package-conf flags
+   pkg_map <- foldM (readPackageConfig dflags) emptyPackageConfigMap
+                (reverse pkgconfs ++ extraPkgConfs dflags)
+
+   return pkg_map
+
+
+getSystemPackageConfigs :: DynFlags -> IO [FilePath]
+getSystemPackageConfigs dflags = do
        -- System one always comes first
    system_pkgconf <- getPackageConfigPath
-   pkg_map1 <- readPackageConfig dflags emptyPackageConfigMap system_pkgconf
+
+       -- allow package.conf.d to contain a bunch of .conf files
+       -- containing package specifications.  This is an easier way
+       -- 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"
+   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
+                      | file <- files
+                      , isSuffixOf ".conf" file]
+       else return []
 
        -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
        -- unless the -no-user-package-conf flag was given.
        -- We only do this when getAppUserDataDirectory is available 
        -- (GHC >= 6.3).
-   (exists, pkgconf) <- catch (do
+   user_pkgconf <- handle (\_ -> return []) $ do
       appdir <- getAppUserDataDirectory "ghc"
       let 
         pkgconf = appdir
                   `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
                   `joinFileName` "package.conf"
       flg <- doesFileExist pkgconf
-      return (flg, pkgconf))
-       -- gobble them all up and turn into False.
-      (\ _ -> return (False, ""))
-   pkg_map2 <- if (dopt Opt_ReadUserPackageConf dflags && exists)
-                 then readPackageConfig dflags pkg_map1 pkgconf
-                 else return pkg_map1
-
-       -- Read all the ones mentioned in -package-conf flags
-   pkg_map <- foldM (readPackageConfig dflags) pkg_map2
-                (extraPkgConfs dflags)
+      if (flg && dopt Opt_ReadUserPackageConf dflags)
+       then return [pkgconf]
+       else return []
 
-   return pkg_map
+   return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
 
 
 readPackageConfig
@@ -559,7 +582,7 @@ getPackageLinkOpts dflags pkgs = do
       rts_tag = rtsBuildTag dflags
   let 
        imp        = if opt_Static then "" else "_dyn"
-       libs p     = map ((++imp) . addSuffix) (hACK (hsLibraries p))
+       libs p     = map ((++imp) . addSuffix) (hsLibraries p)
                         ++ hACK_dyn (extraLibraries p)
        all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
 
@@ -570,7 +593,8 @@ getPackageLinkOpts dflags pkgs = do
         addSuffix other_lib      = other_lib ++ suffix
 
         -- This is a hack that's even more horrible (and hopefully more temporary)
-        -- than the one below. HSbase_cbits and friends require the _dyn suffix
+        -- than the one below [referring to previous splittage of HSbase into chunks
+       -- to work around GNU ld bug]. HSbase_cbits and friends require the _dyn suffix
         -- for dynamic linking, but not _p or other 'way' suffix. So we just add
         -- _dyn to extraLibraries if they already have a _cbits suffix.
         
@@ -579,41 +603,6 @@ getPackageLinkOpts dflags pkgs = do
                          | otherwise = lib
 
   return (concat (map all_opts ps))
-  where
-
-     -- This is a totally horrible (temporary) hack, for Win32.  Problem is
-     -- that package.conf for Win32 says that the main prelude lib is 
-     -- split into HSbase1, HSbase2 and HSbase3, which is needed due to a bug
-     -- in the GNU linker (PEi386 backend). However, we still only
-     -- have HSbase.a for static linking, not HSbase{1,2,3}.a
-     -- getPackageLibraries is called to find the .a's to add to the static
-     -- link line.  On Win32, this hACK detects HSbase{1,2,3} and 
-     -- replaces them with HSbase, so static linking still works.
-     -- Libraries needed for dynamic (GHCi) linking are discovered via
-     -- different route (in InteractiveUI.linkPackage).
-     -- See driver/PackageSrc.hs for the HSbase1/HSbase2 split definition.
-     -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
-     -- JRS 04 Sept 01: Same appalling hack for HSwin32[1,2]
-     -- KAA 29 Mar  02: Same appalling hack for HSobjectio[1,2,3,4]
-     --
-     -- [sof 03/05: Renamed the (moribund) HSwin32 to HSwin_32 so as to
-     --  avoid filename conflicts with the 'Win32' package on a case-insensitive filesystem]
-     hACK libs
-#      if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
-       = libs
-#      else
-       = if   "HSbase1" `elem` libs && "HSbase2" `elem` libs && "HSbase3" `elem` libs
-         then "HSbase" : filter (not.(isPrefixOf "HSbase")) libs
-         else
-         if   "HSwin_321" `elem` libs && "HSwin_322" `elem` libs
-         then "HSwin_32" : filter (not.(isPrefixOf "HSwin_32")) libs
-         else 
-         if   "HSobjectio1" `elem` libs && "HSobjectio2" `elem` libs && "HSobjectio3" `elem` libs && "HSobjectio4" `elem` libs
-        then "HSobjectio" : filter (not.(isPrefixOf "HSobjectio")) libs
-         else 
-         libs
-#      endif
-
 
 getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
 getPackageExtraCcOpts dflags pkgs = do