X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=44ad7d15b252539bab967a02bf37baa8b6b0e386;hb=cec9b62f2ccdd358aa1d99c4143794b541b87f7e;hp=b6c320fcadea58d4958581ce06fe381e1753849f;hpb=1a50b338952e91251197d4cf4c4f0a0e266e99a7;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index b6c320f..44ad7d1 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -55,13 +55,13 @@ import Distribution.Text import Distribution.Version import FastString import ErrUtils ( debugTraceMsg, putMsg, Message ) +import Exception import System.Directory import System.FilePath import Data.Maybe import Control.Monad import Data.List -import Control.Exception ( throwDyn ) -- --------------------------------------------------------------------------- -- The Package state @@ -173,7 +173,7 @@ initPackages dflags = do readPackageConfigs :: DynFlags -> IO PackageConfigMap readPackageConfigs dflags = do - e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH") + e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH") system_pkgconfs <- getSystemPackageConfigs dflags let pkgconfs = case e_pkg_path of @@ -216,7 +216,7 @@ getSystemPackageConfigs dflags = do -- unless the -no-user-package-conf flag was given. -- We only do this when getAppUserDataDirectory is available -- (GHC >= 6.3). - user_pkgconf <- handle (\_ -> return []) $ do + user_pkgconf <- do appdir <- getAppUserDataDirectory "ghc" let pkgconf = appdir @@ -226,6 +226,7 @@ getSystemPackageConfigs dflags = do if (flg && dopt Opt_ReadUserPackageConf dflags) then return [pkgconf] else return [] + `catchIO` (\_ -> return []) return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf]) @@ -687,7 +688,7 @@ closeDeps pkg_map ps = throwErr (closeDepsErr pkg_map ps) throwErr :: MaybeErr Message a -> IO a throwErr m = case m of - Failed e -> throwDyn (CmdLineError (showSDoc e)) + Failed e -> ghcError (CmdLineError (showSDoc e)) Succeeded r -> return r closeDepsErr :: PackageConfigMap -> [(PackageId,Maybe PackageId)] @@ -710,7 +711,7 @@ add_package pkg_db ps (p, mb_parent) return (p : ps') missingPackageErr :: String -> IO [PackageConfig] -missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p))) +missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p))) missingPackageMsg :: String -> SDoc missingPackageMsg p = ptext (sLit "unknown package:") <+> text p