X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=a7c01aef6adcfd5a6f79cd5278484d28021c48bd;hb=e314b86f6290e5440a46cd5cc29f7878cb78c6fb;hp=2647a5fab0d9530e317cb90ff7f0f95b119e2d72;hpb=a9c09ca0546d62408356bc83bca92d8e88a5df7f;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 2647a5f..a7c01ae 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -4,13 +4,6 @@ % Package manipulation % \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Packages ( module PackageConfig, @@ -26,7 +19,6 @@ module Packages ( -- * Inspecting the set of packages in scope getPackageIncludePath, - getPackageCIncludes, getPackageLibraryPath, getPackageLinkOpts, getPackageExtraCcOpts, @@ -289,6 +281,7 @@ applyPackageFlag pkgs flag = ExposePackage str -> case matchingPackages str pkgs of Nothing -> missingPackageErr str + Just ([], _) -> panic "applyPackageFlag" Just (p:ps,qs) -> return (p':ps') where p' = p {exposed=True} ps' = hideAll (pkgName (package p)) (ps++qs) @@ -302,7 +295,7 @@ applyPackageFlag pkgs flag = IgnorePackage str -> case matchingPackages str pkgs of Nothing -> return pkgs - Just (ps,qs) -> return qs + Just (_, qs) -> return qs -- missing package is not an error for -ignore-package, -- because a common usage is to -ignore-package P as -- a preventative measure just in case P exists. @@ -327,11 +320,14 @@ matchingPackages str pkgs = str == showPackageId (package p) || str == pkgName (package p) - +pickPackages :: [PackageConfig] -> [String] -> [PackageConfig] pickPackages pkgs strs = - [ p | p <- strs, Just (p:ps,_) <- [matchingPackages p pkgs] ] + [ p | p <- strs, Just (p:_, _) <- [matchingPackages p pkgs] ] +sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m] sortByVersion = sortBy (flip (comparing (pkgVersion.package))) + +comparing :: Ord a => (t -> a) -> t -> t -> Ordering comparing f a b = f a `compare` f b -- ----------------------------------------------------------------------------- @@ -380,10 +376,12 @@ findWiredInPackages dflags pkgs preload this_package = do -- their canonical names (eg. base-1.0 ==> base). -- let - wired_in_pkgids = [ basePackageId, - rtsPackageId, - haskell98PackageId, - thPackageId, + wired_in_pkgids = [ primPackageId, + integerPackageId, + basePackageId, + rtsPackageId, + haskell98PackageId, + thPackageId, ndpPackageId ] wired_in_names = map packageIdString wired_in_pkgids @@ -534,7 +532,6 @@ mkPackageState dflags orig_pkg_db preload0 this_package = do pkgs <- elimDanglingDeps dflags pkgs3 ignored let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs - pkgids = map packageConfigId pkgs -- add base & rts to the preload packages basicLinkedPackages = filter (flip elemUFM pkg_db) @@ -595,11 +592,6 @@ getPackageIncludePath dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (nub (filter notNull (concatMap includeDirs ps))) - -- includes are in reverse dependency order (i.e. rts first) -getPackageCIncludes :: [PackageConfig] -> IO [String] -getPackageCIncludes pkg_configs = do - return (reverse (nub (filter notNull (concatMap includes pkg_configs)))) - getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String] getPackageLibraryPath dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs @@ -693,9 +685,13 @@ add_package pkg_db ps (p, mb_parent) ps' <- foldM (add_package pkg_db) ps (zip deps (repeat (Just p))) return (p : ps') +missingPackageErr :: String -> IO [PackageConfig] missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p))) + +missingPackageMsg :: String -> SDoc missingPackageMsg p = ptext SLIT("unknown package:") <+> text p +missingDependencyMsg :: Maybe PackageId -> SDoc missingDependencyMsg Nothing = empty missingDependencyMsg (Just parent) = space <> parens (ptext SLIT("dependency of") <+> ftext (packageIdFS parent))