diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/PackageConfig.hs | 44 | ||||
| -rw-r--r-- | compiler/main/Packages.lhs | 28 |
2 files changed, 34 insertions, 38 deletions
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 3124e292c1..038291d6b3 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -29,9 +29,9 @@ module PackageConfig ( #include "HsVersions.h" import GHC.PackageDb -import qualified Data.ByteString.Char8 as BS import Data.Version +import FastString import Outputable import Module @@ -46,54 +46,50 @@ type PackageConfig = InstalledPackageInfo Module.PackageKey Module.ModuleName -newtype InstalledPackageId = InstalledPackageId String deriving (Eq, Ord, Show) -newtype SourcePackageId = SourcePackageId String deriving (Eq, Ord, Show) -newtype PackageName = PackageName String deriving (Eq, Ord, Show) +-- TODO: there's no need for these to be FastString, as we don't need the uniq +-- feature, but ghc doesn't currently have convenient support for any +-- other compact string types, e.g. plain ByteString or Text. + +newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord) +newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord) +newtype PackageName = PackageName FastString deriving (Eq, Ord) instance BinaryStringRep InstalledPackageId where - fromStringRep = InstalledPackageId . BS.unpack - toStringRep (InstalledPackageId s) = BS.pack s + fromStringRep = InstalledPackageId . mkFastStringByteString + toStringRep (InstalledPackageId s) = fastStringToByteString s instance BinaryStringRep SourcePackageId where - fromStringRep = SourcePackageId . BS.unpack - toStringRep (SourcePackageId s) = BS.pack s + fromStringRep = SourcePackageId . mkFastStringByteString + toStringRep (SourcePackageId s) = fastStringToByteString s instance BinaryStringRep PackageName where - fromStringRep = PackageName . BS.unpack - toStringRep (PackageName s) = BS.pack s - -instance BinaryStringRep PackageKey where - fromStringRep = Module.stringToPackageKey . BS.unpack - toStringRep = BS.pack . Module.packageKeyString - -instance BinaryStringRep Module.ModuleName where - fromStringRep = Module.mkModuleName . BS.unpack - toStringRep = BS.pack . Module.moduleNameString + fromStringRep = PackageName . mkFastStringByteString + toStringRep (PackageName s) = fastStringToByteString s instance Outputable InstalledPackageId where - ppr (InstalledPackageId str) = text str + ppr (InstalledPackageId str) = ftext str instance Outputable SourcePackageId where - ppr (SourcePackageId str) = text str + ppr (SourcePackageId str) = ftext str instance Outputable PackageName where - ppr (PackageName str) = text str + ppr (PackageName str) = ftext str defaultPackageConfig :: PackageConfig defaultPackageConfig = emptyInstalledPackageInfo installedPackageIdString :: PackageConfig -> String -installedPackageIdString pkg = str +installedPackageIdString pkg = unpackFS str where InstalledPackageId str = installedPackageId pkg sourcePackageIdString :: PackageConfig -> String -sourcePackageIdString pkg = str +sourcePackageIdString pkg = unpackFS str where SourcePackageId str = sourcePackageId pkg packageNameString :: PackageConfig -> String -packageNameString pkg = str +packageNameString pkg = unpackFS str where PackageName str = packageName pkg diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index af2d3fe952..37ddd846ee 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -890,7 +890,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ] ipid_selected = depClosure ipid_map - [ InstalledPackageId i + [ InstalledPackageId (mkFastString i) | ExposePackage (PackageIdArg i) _ <- flags ] (ignore_flags, other_flags) = partition is_ignore flags @@ -965,9 +965,9 @@ mkPackageState dflags pkgs0 preload0 this_package = do ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p) | p <- pkgs3 ] - lookupIPID ipid@(InstalledPackageId str) + lookupIPID ipid | Just pid <- Map.lookup ipid ipid_map = return pid - | otherwise = missingPackageErr dflags str + | otherwise = missingPackageErr dflags ipid preload2 <- mapM lookupIPID preload1 @@ -1352,25 +1352,25 @@ add_package pkg_db ipid_map ps (p, mb_parent) | p `elem` ps = return ps -- Check if we've already added this package | otherwise = case lookupPackage' pkg_db p of - Nothing -> Failed (missingPackageMsg (packageKeyString p) <> + Nothing -> Failed (missingPackageMsg p <> missingDependencyMsg mb_parent) Just pkg -> do -- Add the package's dependents also ps' <- foldM add_package_ipid ps (depends pkg) return (p : ps') where - add_package_ipid ps ipid@(InstalledPackageId str) + add_package_ipid ps ipid | Just pid <- Map.lookup ipid ipid_map = add_package pkg_db ipid_map ps (pid, Just p) | otherwise - = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent) + = Failed (missingPackageMsg ipid <> missingDependencyMsg mb_parent) -missingPackageErr :: DynFlags -> String -> IO a +missingPackageErr :: Outputable pkgid => DynFlags -> pkgid -> IO a missingPackageErr dflags p = throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p))) -missingPackageMsg :: String -> SDoc -missingPackageMsg p = ptext (sLit "unknown package:") <+> text p +missingPackageMsg :: Outputable pkgid => pkgid -> SDoc +missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p missingDependencyMsg :: Maybe PackageKey -> SDoc missingDependencyMsg Nothing = empty @@ -1435,11 +1435,11 @@ pprPackagesWith pprIPI dflags = -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) pprPackagesSimple :: DynFlags -> SDoc -pprPackagesSimple = pprPackagesWith (text . showIPI) - where showIPI ipi = let InstalledPackageId i = installedPackageId ipi - e = if exposed ipi then "E" else " " - t = if trusted ipi then "T" else " " - in e ++ t ++ " " ++ i +pprPackagesSimple = pprPackagesWith pprIPI + where pprIPI ipi = let InstalledPackageId i = installedPackageId ipi + e = if exposed ipi then text "E" else text " " + t = if trusted ipi then text "T" else text " " + in e <> t <> text " " <> ftext i -- | Show the mapping of modules to where they come from. pprModuleMap :: DynFlags -> SDoc |