X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FPackages.lhs;h=21c5596b64ba28fefc8541013da2afc2e7f6757e;hb=a004ae5ab1167ddfaa4cdf4b8d9df2ce92e541a2;hp=6f0b867f61ca1efa7540fba9f6935f15877187cd;hpb=efbbd977b60efc357b134124c8a9152d9b704811;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index 6f0b867..21c5596 100644
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -66,11 +66,12 @@ import Distribution.Version
 import Data.Maybe	( isNothing )
 import System.Directory	( doesFileExist )
 import Control.Monad	( foldM )
-import Data.List	( nub, partition )
+import Data.List	( nub, partition, sortBy )
 
 #ifdef mingw32_TARGET_OS
 import Data.List	( isPrefixOf )
 #endif
+import Data.List        ( isSuffixOf )
 
 import FastString
 import EXCEPTION	( throwDyn )
@@ -289,20 +290,18 @@ mkPackageState dflags orig_pkg_db = do
 
 	procflags pkgs expl [] = return (pkgs,expl)
 	procflags pkgs expl (ExposePackage str : flags) = do
-	   case partition (matches str) pkgs of
-		([],_)   -> missingPackageErr str
-		([p],ps) -> procflags (p':ps') expl' flags
+	   case pick str pkgs of
+		Nothing -> missingPackageErr str
+		Just (p,ps) -> procflags (p':ps') expl' flags
 		  where pkgid = packageConfigId p
 			p' = p {exposed=True}
 		        ps' = hideAll (pkgName (package p)) ps
 			expl' = addOneToUniqSet expl pkgid
-		(ps,_)   -> multiplePackagesErr str ps
 	procflags pkgs expl (HidePackage str : flags) = do
 	   case partition (matches str) pkgs of
 		([],_)   -> missingPackageErr str
-		([p],ps) -> procflags (p':ps) expl flags
-		  where p' = p {exposed=False}
-		(ps,_)   -> multiplePackagesErr str ps
+		(ps,qs) -> procflags (map hide ps ++ qs) expl flags
+		  where hide p = p {exposed=False}
 	procflags pkgs expl (IgnorePackage str : flags) = do
 	   case partition (matches str) pkgs of
 		(ps,qs) -> procflags qs expl flags
@@ -310,6 +309,16 @@ mkPackageState dflags orig_pkg_db = do
 		-- because a common usage is to -ignore-package P as
 		-- a preventative measure just in case P exists.
 
+	pick str pkgs
+	  = case partition (matches str) pkgs of
+		([],_) -> Nothing
+		(ps,rest) -> 
+		   case sortBy (flip (comparing (pkgVersion.package))) ps of
+			(p:ps) -> Just (p, ps ++ rest)
+			_ -> panic "Packages.pick"
+
+        comparing f a b = f a `compare` f b
+
 	-- A package named on the command line can either include the
 	-- version, or just the name if it is unambiguous.
 	matches str p
@@ -337,7 +346,8 @@ mkPackageState dflags orig_pkg_db = do
 		  where myname = pkgName (package p)
 			myversion = pkgVersion (package p)
 			a_later_version_is_exposed
-			  = not (null [ p | p <- pkgs1, let pkg = package p,
+			  = not (null [ p | p <- pkgs1, exposed p,
+					    let pkg = package p,
 					    pkgName pkg == myname,
 					    pkgVersion pkg > myversion ])
   --
@@ -413,13 +423,6 @@ haskell98PackageName = FSLIT("haskell98")
 thPackageName        = FSLIT("template-haskell")
 				-- Template Haskell libraries in here
 
-multiplePackagesErr str ps =
-  throwDyn (CmdLineError (showSDoc (
-		   text "Error; multiple packages match" <+> 
-			text str <> colon <+>
-		    sep (punctuate comma (map (text.showPackageId.package) ps))
-		)))
-
 mkModuleMap
   :: PackageConfigMap
   -> [PackageId]
@@ -537,7 +540,8 @@ getPackageLinkOpts dflags pkgs = do
       rts_tag = rtsBuildTag dflags
   let 
 	imp        = if opt_Static then "" else "_dyn"
-      	libs p     = map ((++imp) . addSuffix) (hACK (hsLibraries p)) ++ extraLibraries p
+      	libs p     = map ((++imp) . addSuffix) (hACK (hsLibraries p))
+      	                 ++ hACK_dyn (extraLibraries p)
 	all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
 
 	suffix     = if null tag then "" else  '_':tag
@@ -546,6 +550,15 @@ getPackageLinkOpts dflags pkgs = do
         addSuffix rts@"HSrts"    = rts       ++ rts_suffix
         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
+        -- for dynamic linking, but not _p or other 'way' suffix. So we just add
+        -- _dyn to extraLibraries if they already have a _cbits suffix.
+        
+        hACK_dyn = map hack
+          where hack lib | not opt_Static && "_cbits" `isSuffixOf` lib = lib ++ "_dyn"
+                         | otherwise = lib
+
   return (concat (map all_opts ps))
   where
 
@@ -582,6 +595,7 @@ getPackageLinkOpts dflags pkgs = do
          libs
 #      endif
 
+
 getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
 getPackageExtraCcOpts dflags pkgs = do
   ps <- getExplicitPackagesAnd dflags pkgs
@@ -640,7 +654,7 @@ add_package pkg_db ps p
   | p `elem` ps = return ps	-- Check if we've already added this package
   | otherwise =
       case lookupPackage pkg_db p of
-        Nothing -> Failed (missingPackageErr (packageIdString p))
+        Nothing -> Failed (missingPackageMsg (packageIdString p))
         Just pkg -> do
     	   -- Add the package's dependents also
 	   let deps = map mkPackageId (depends pkg)
@@ -648,7 +662,7 @@ add_package pkg_db ps p
     	   return (p : ps')
 
 missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
-missingPackageMsg p = ptext SLIT("unknown package:") <> text p
+missingPackageMsg p = ptext SLIT("unknown package:") <+> text p
 
 -- -----------------------------------------------------------------------------
 -- The home module set