[project @ 2005-01-27 11:50:58 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / Packages.lhs

diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index 5e0cfa1..4b758b2 100644 (file)
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -12,7 +12,8 @@ module Packages (
        extendPackageConfigMap, dumpPackages,
 
        -- * Reading the package config, and processing cmdline args
-       PackageState(..),
+       PackageIdH(..), isHomePackage,
+       PackageState(..), 
        initPackages,
        moduleToPackageConfig,
        getPackageDetails,
@@ -33,14 +34,16 @@ module Packages (
     )
 where
 
+#include "../includes/ghcconfig.h"
+-- Needed for mingw32_TARGET_OS defn
+
 #include "HsVersions.h"
 
 import PackageConfig   
 import DriverState     ( v_Build_tag, v_RTS_Build_tag, v_Static )
 import SysTools                ( getTopDir, getPackageConfigPath )
 import ParsePkgConf    ( loadPackageConfig )
-import CmdLineOpts     ( DynFlags(..), PackageFlag(..), verbosity,
-                         opt_Static )
+import CmdLineOpts     ( DynFlags(..), PackageFlag(..), opt_Static )
 import Config          ( cTARGETARCH, cTARGETOS, cProjectVersion )
 import Name            ( Name, nameModule_maybe )
 import Module          ( Module, mkModule )
@@ -58,12 +61,17 @@ import Compat.Directory     ( getAppUserDataDirectory )
 
 import Distribution.InstalledPackageInfo
 import Distribution.Package
+import Distribution.Version
 import System.IO       ( hPutStrLn, stderr )
-import Data.Version
 import Data.Maybe      ( fromJust, isNothing )
 import System.Directory        ( doesFileExist )
 import Control.Monad   ( when, foldM )
 import Data.List       ( nub, partition )
+
+#ifdef mingw32_TARGET_OS
+import Data.List       ( isPrefixOf )
+#endif
+
 import FastString
 import DATA_IOREF
 import EXCEPTION       ( throwDyn )
@@ -140,12 +148,22 @@ data PackageState = PackageState {
        -- exposed is True if the package exposes that module.
 
   -- The PackageIds of some known packages
-  basePackageId                :: Maybe PackageId,
-  rtsPackageId         :: Maybe PackageId,
-  haskell98PackageId   :: Maybe PackageId,
-  thPackageId          :: Maybe PackageId
+  basePackageId                :: PackageIdH,
+  rtsPackageId         :: PackageIdH,
+  haskell98PackageId   :: PackageIdH,
+  thPackageId          :: PackageIdH
   }
 
+data PackageIdH 
+   = HomePackage               -- The "home" package is the package curently
+                               -- being compiled
+   | ExtPackage PackageId      -- An "external" package is any other package
+
+
+isHomePackage :: PackageIdH -> Bool
+isHomePackage HomePackage    = True
+isHomePackage (ExtPackage _) = False
+
 -- A PackageConfigMap maps a PackageId to a PackageConfig
 type PackageConfigMap = UniqFM PackageConfig
 
@@ -216,8 +234,8 @@ readPackageConfig dflags pkg_map conf_file = do
 
 
 mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$libdir" at the beginning of a path
--- with the current libdir (obtained from the -B option).
+-- Replace the string "$topdir" at the beginning of a path
+-- with the current topdir (obtained from the -B option).
 mungePackagePaths top_dir ps = map munge_pkg ps
  where 
   munge_pkg p = p{ importDirs  = munge_paths (importDirs p),
@@ -228,7 +246,7 @@ mungePackagePaths top_dir ps = map munge_pkg ps
   munge_paths = map munge_path
 
   munge_path p 
-         | Just p' <- maybePrefixMatch "$libdir" p = top_dir ++ p'
+         | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
          | otherwise                               = p
 
 
@@ -304,12 +322,13 @@ mkPackageState dflags pkg_db = do
   -- Look up some known PackageIds
   --
   let
+       lookupPackageByName :: FastString -> PackageIdH
        lookupPackageByName nm = 
          case [ conf | p <- dep_exposed,
                        Just conf <- [lookupPackage pkg_db p],
                        nm == mkFastString (pkgName (package conf)) ] of
-               []     -> Nothing
-               (p:ps) -> Just (mkPackageId (package p))
+               []     -> HomePackage
+               (p:ps) -> ExtPackage (mkPackageId (package p))
 
        -- Get the PackageIds for some known packages (we know the names,
        -- but we don't know the versions).  Some of these packages might
@@ -322,7 +341,7 @@ mkPackageState dflags pkg_db = do
        -- add base & rts to the explicit packages
        basicLinkedPackages = [basePackageId,rtsPackageId]
        explicit' = addListToUniqSet explicit 
-                       [ p | Just p <- basicLinkedPackages ]
+                       [ p | ExtPackage p <- basicLinkedPackages ]
   --
   -- Close the explicit packages with their dependencies
   --
@@ -421,10 +440,9 @@ getPackageLinkOpts dflags pkgs = do
   rts_tag <- readIORef v_RTS_Build_tag
   static <- readIORef v_Static
   let 
-       imp        = if static then "" else "_imp"
-       libs p     = map addSuffix (hACK (hsLibraries p)) ++ extraLibraries p
-       imp_libs p = map (++imp) (libs p)
-       all_opts p = map ("-l" ++) (imp_libs p) ++ extraLdOpts p
+       imp        = if static then "" else "_dyn"
+       libs p     = map ((++imp) . addSuffix) (hACK (hsLibraries p)) ++ extraLibraries p
+       all_opts p = map ("-l" ++) (libs p) ++ extraLdOpts p
 
        suffix     = if null tag then "" else  '_':tag
        rts_suffix = if null rts_tag then "" else  '_':rts_tag