5973bc5d4ba2c69687bb5366269ea16ce3fdfaeb
[ghc.git] / compiler / main / Packages.lhs
1 %
2 % (c) The University of Glasgow, 2006
3 %
4 \begin{code}
5 {-# LANGUAGE CPP #-}
6
7 -- | Package manipulation
8 module Packages (
9         module PackageConfig,
10
11         -- * The PackageConfigMap
12         PackageConfigMap, emptyPackageConfigMap, lookupPackage,
13         extendPackageConfigMap, dumpPackages, simpleDumpPackages,
14
15         -- * Reading the package config, and processing cmdline args
16         PackageState(..),
17         ModuleConf(..),
18         initPackages,
19         getPackageDetails,
20         lookupModuleInAllPackages, lookupModuleWithSuggestions,
21
22         -- * Inspecting the set of packages in scope
23         getPackageIncludePath,
24         getPackageLibraryPath,
25         getPackageLinkOpts,
26         getPackageExtraCcOpts,
27         getPackageFrameworkPath,
28         getPackageFrameworks,
29         getPreloadPackagesAnd,
30
31         collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
32         packageHsLibs,
33         ModuleExport(..),
34
35         -- * Utils
36         isDllName
37     )
38 where
39
40 #include "HsVersions.h"
41
42 import PackageConfig
43 import DynFlags
44 import Config           ( cProjectVersion )
45 import Name             ( Name, nameModule_maybe )
46 import UniqFM
47 import Module
48 import Util
49 import Panic
50 import Outputable
51 import Maybes
52
53 import System.Environment ( getEnv )
54 import Distribution.InstalledPackageInfo
55 import Distribution.InstalledPackageInfo.Binary
56 import Distribution.Package hiding (PackageId,depends)
57 import Distribution.ModuleExport
58 import FastString
59 import ErrUtils         ( debugTraceMsg, putMsg, MsgDoc )
60 import Exception
61
62 import System.Directory
63 import System.FilePath as FilePath
64 import qualified System.FilePath.Posix as FilePath.Posix
65 import Control.Monad
66 import Data.Char (isSpace)
67 import Data.List as List
68 import Data.Map (Map)
69 import qualified Data.Map as Map
70 import qualified FiniteMap as Map
71 import qualified Data.Set as Set
72
73 -- ---------------------------------------------------------------------------
74 -- The Package state
75
76 -- | Package state is all stored in 'DynFlags', including the details of
77 -- all packages, which packages are exposed, and which modules they
78 -- provide.
79 --
80 -- The package state is computed by 'initPackages', and kept in DynFlags.
81 -- It is influenced by various package flags:
82 --
83 --   * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.
84 --     If @-hide-all-packages@ was not specified, these commands also cause
85 --      all other packages with the same name to become hidden.
86 --
87 --   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.
88 --
89 --   * (there are a few more flags, check below for their semantics)
90 --
91 -- The package state has the following properties.
92 --
93 --   * Let @exposedPackages@ be the set of packages thus exposed.
94 --     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of
95 --     their dependencies.
96 --
97 --   * When searching for a module from an preload import declaration,
98 --     only the exposed modules in @exposedPackages@ are valid.
99 --
100 --   * When searching for a module from an implicit import, all modules
101 --     from @depExposedPackages@ are valid.
102 --
103 --   * When linking in a compilation manager mode, we link in packages the
104 --     program depends on (the compiler knows this list by the
105 --     time it gets to the link step).  Also, we link in all packages
106 --     which were mentioned with preload @-package@ flags on the command-line,
107 --     or are a transitive dependency of same, or are \"base\"\/\"rts\".
108 --     The reason for this is that we might need packages which don't
109 --     contain any Haskell modules, and therefore won't be discovered
110 --     by the normal mechanism of dependency tracking.
111
112 -- Notes on DLLs
113 -- ~~~~~~~~~~~~~
114 -- When compiling module A, which imports module B, we need to
115 -- know whether B will be in the same DLL as A.
116 --      If it's in the same DLL, we refer to B_f_closure
117 --      If it isn't, we refer to _imp__B_f_closure
118 -- When compiling A, we record in B's Module value whether it's
119 -- in a different DLL, by setting the DLL flag.
120
121 -- | The result of performing a lookup on moduleToPkgConfAll, this
122 -- is one possible provider of a module.
123 data ModuleConf = ModConf {
124   -- | The original name of the module
125   modConfName :: ModuleName,
126   -- | The original package (config) of the module
127   modConfPkg :: PackageConfig,
128   -- | Does the original package expose this module to its clients?  This
129   -- is cached result of whether or not the module name is in
130   -- exposed-modules or reexported-modules in the package config.  While
131   -- this isn't actually how we want to figure out if a module is visible,
132   -- this is important for error messages.
133   modConfExposed :: Bool,
134   -- | Is the module visible to our current compilation?  Interestingly,
135   -- this is not the same as if it was exposed: if the package is hidden
136   -- then exposed modules are not visible.  However, if another exposed
137   -- package reexports the module in question, it's now visible!  You
138   -- can't tell this just by looking at the original name, so we
139   -- record the calculation here.
140   modConfVisible :: Bool
141   }
142
143 -- | Map from 'PackageId' (used for documentation)
144 type PackageIdMap = UniqFM
145
146 -- | Map from 'Module' to 'PackageId' to 'ModuleConf', see 'moduleToPkgConfAll'
147 type ModuleToPkgConfAll = UniqFM (PackageIdMap ModuleConf)
148
149 data PackageState = PackageState {
150   pkgIdMap              :: PackageConfigMap, -- PackageKey   -> PackageConfig
151         -- The exposed flags are adjusted according to -package and
152         -- -hide-package flags, and -ignore-package removes packages.
153
154   preloadPackages      :: [PackageKey],
155         -- The packages we're going to link in eagerly.  This list
156         -- should be in reverse dependency order; that is, a package
157         -- is always mentioned before the packages it depends on.
158
159   -- | ModuleEnv mapping, derived from 'pkgIdMap'.
160   -- Maps 'Module' to an original module which is providing the module name.
161   -- Since the module may be provided by multiple packages, this result
162   -- is further recorded in a map of the original package IDs to
163   -- module information.  The 'modSummaryPkgConf' should agree with
164   -- this key.  Generally, 'modSummaryName' will be the same as the
165   -- module key, unless there is renaming.
166   moduleToPkgConfAll    :: ModuleToPkgConfAll,
167
168   installedPackageIdMap :: InstalledPackageIdMap
169   }
170
171 -- | A PackageConfigMap maps a 'PackageKey' to a 'PackageConfig'
172 type PackageConfigMap = UniqFM PackageConfig
173
174 type InstalledPackageIdMap = Map InstalledPackageId PackageKey
175
176 type InstalledPackageIndex = Map InstalledPackageId PackageConfig
177
178 emptyPackageConfigMap :: PackageConfigMap
179 emptyPackageConfigMap = emptyUFM
180
181 -- | Find the package we know about with the given id (e.g. \"foo-1.0\"), if any
182 lookupPackage :: PackageConfigMap -> PackageKey -> Maybe PackageConfig
183 lookupPackage = lookupUFM
184
185 extendPackageConfigMap
186    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
187 extendPackageConfigMap pkg_map new_pkgs
188   = foldl add pkg_map new_pkgs
189   where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
190
191 -- | Looks up the package with the given id in the package state, panicing if it is
192 -- not found
193 getPackageDetails :: PackageState -> PackageKey -> PackageConfig
194 getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdMap ps) pid)
195
196 -- ----------------------------------------------------------------------------
197 -- Loading the package db files and building up the package state
198
199 -- | Call this after 'DynFlags.parseDynFlags'.  It reads the package
200 -- database files, and sets up various internal tables of package
201 -- information, according to the package-related flags on the
202 -- command-line (@-package@, @-hide-package@ etc.)
203 --
204 -- Returns a list of packages to link in if we're doing dynamic linking.
205 -- This list contains the packages that the user explicitly mentioned with
206 -- @-package@ flags.
207 --
208 -- 'initPackages' can be called again subsequently after updating the
209 -- 'packageFlags' field of the 'DynFlags', and it will update the
210 -- 'pkgState' in 'DynFlags' and return a list of packages to
211 -- link in.
212 initPackages :: DynFlags -> IO (DynFlags, [PackageKey])
213 initPackages dflags = do
214   pkg_db <- case pkgDatabase dflags of
215                 Nothing -> readPackageConfigs dflags
216                 Just db -> return $ setBatchPackageFlags dflags db
217   (pkg_state, preload, this_pkg)
218         <- mkPackageState dflags pkg_db [] (thisPackage dflags)
219   return (dflags{ pkgDatabase = Just pkg_db,
220                   pkgState = pkg_state,
221                   thisPackage = this_pkg },
222           preload)
223
224 -- -----------------------------------------------------------------------------
225 -- Reading the package database(s)
226
227 readPackageConfigs :: DynFlags -> IO [PackageConfig]
228 readPackageConfigs dflags = do
229   let system_conf_refs = [UserPkgConf, GlobalPkgConf]
230
231   e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
232   let base_conf_refs = case e_pkg_path of
233         Left _ -> system_conf_refs
234         Right path
235          | null (last cs)
236          -> map PkgConfFile (init cs) ++ system_conf_refs
237          | otherwise
238          -> map PkgConfFile cs
239          where cs = parseSearchPath path
240          -- if the path ends in a separator (eg. "/foo/bar:")
241          -- then we tack on the system paths.
242
243   let conf_refs = reverse (extraPkgConfs dflags base_conf_refs)
244   -- later packages shadow earlier ones.  extraPkgConfs
245   -- is in the opposite order to the flags on the
246   -- command line.
247   confs <- liftM catMaybes $ mapM (resolvePackageConfig dflags) conf_refs
248
249   liftM concat $ mapM (readPackageConfig dflags) confs
250
251 resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
252 resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)
253 resolvePackageConfig _ UserPkgConf = handleIO (\_ -> return Nothing) $ do
254   appdir <- getAppUserDataDirectory "ghc"
255   let dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
256       pkgconf = dir </> "package.conf.d"
257   exist <- doesDirectoryExist pkgconf
258   return $ if exist then Just pkgconf else Nothing
259 resolvePackageConfig _ (PkgConfFile name) = return $ Just name
260
261 readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
262 readPackageConfig dflags conf_file = do
263   isdir <- doesDirectoryExist conf_file
264
265   proto_pkg_configs <-
266     if isdir
267        then do let filename = conf_file </> "package.cache"
268                debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
269                conf <- readBinPackageDB filename
270                return (map installedPackageInfoToPackageConfig conf)
271
272        else do
273             isfile <- doesFileExist conf_file
274             when (not isfile) $
275               throwGhcExceptionIO $ InstallationError $
276                 "can't find a package database at " ++ conf_file
277             debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
278             str <- readFile conf_file
279             case reads str of
280                 [(configs, rest)]
281                     | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
282                 _ -> throwGhcExceptionIO $ InstallationError $
283                         "invalid package database file " ++ conf_file
284
285   let
286       top_dir = topDir dflags
287       pkgroot = takeDirectory conf_file
288       pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
289       pkg_configs2 = setBatchPackageFlags dflags pkg_configs1
290   --
291   return pkg_configs2
292
293 setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
294 setBatchPackageFlags dflags pkgs = (maybeDistrustAll . maybeHideAll) pkgs
295   where
296     maybeHideAll pkgs'
297       | gopt Opt_HideAllPackages dflags = map hide pkgs'
298       | otherwise                       = pkgs'
299
300     maybeDistrustAll pkgs'
301       | gopt Opt_DistrustAllPackages dflags = map distrust pkgs'
302       | otherwise                           = pkgs'
303
304     hide pkg = pkg{ exposed = False }
305     distrust pkg = pkg{ trusted = False }
306
307 -- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
308 mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
309 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
310 -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
311 -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
312 -- The "pkgroot" is the directory containing the package database.
313 --
314 -- Also perform a similar substitution for the older GHC-specific
315 -- "$topdir" variable. The "topdir" is the location of the ghc
316 -- installation (obtained from the -B option).
317 mungePackagePaths top_dir pkgroot pkg =
318     pkg {
319       importDirs  = munge_paths (importDirs pkg),
320       includeDirs = munge_paths (includeDirs pkg),
321       libraryDirs = munge_paths (libraryDirs pkg),
322       frameworkDirs = munge_paths (frameworkDirs pkg),
323       haddockInterfaces = munge_paths (haddockInterfaces pkg),
324       haddockHTMLs = munge_urls (haddockHTMLs pkg)
325     }
326   where
327     munge_paths = map munge_path
328     munge_urls  = map munge_url
329
330     munge_path p
331       | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
332       | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'
333       | otherwise                                = p
334
335     munge_url p
336       | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
337       | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'
338       | otherwise                                   = p
339
340     toUrlPath r p = "file:///"
341                  -- URLs always use posix style '/' separators:
342                  ++ FilePath.Posix.joinPath
343                         (r : -- We need to drop a leading "/" or "\\"
344                              -- if there is one:
345                              dropWhile (all isPathSeparator)
346                                        (FilePath.splitDirectories p))
347
348     -- We could drop the separator here, and then use </> above. However,
349     -- by leaving it in and using ++ we keep the same path separator
350     -- rather than letting FilePath change it to use \ as the separator
351     stripVarPrefix var path = case stripPrefix var path of
352                               Just [] -> Just []
353                               Just cs@(c : _) | isPathSeparator c -> Just cs
354                               _ -> Nothing
355
356
357 -- -----------------------------------------------------------------------------
358 -- Modify our copy of the package database based on a package flag
359 -- (-package, -hide-package, -ignore-package).
360
361 applyPackageFlag
362    :: DynFlags
363    -> UnusablePackages
364    -> [PackageConfig]           -- Initial database
365    -> PackageFlag               -- flag to apply
366    -> IO [PackageConfig]        -- new database
367
368 applyPackageFlag dflags unusable pkgs flag =
369   case flag of
370     ExposePackage str ->
371        case selectPackages (matchingStr str) pkgs unusable of
372          Left ps         -> packageFlagErr dflags flag ps
373          Right (p:ps,qs) -> return (p':ps')
374           where p' = p {exposed=True}
375                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
376          _ -> panic "applyPackageFlag"
377
378     ExposePackageId str ->
379        case selectPackages (matchingId str) pkgs unusable of
380          Left ps         -> packageFlagErr dflags flag ps
381          Right (p:ps,qs) -> return (p':ps')
382           where p' = p {exposed=True}
383                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
384          _ -> panic "applyPackageFlag"
385
386     HidePackage str ->
387        case selectPackages (matchingStr str) pkgs unusable of
388          Left ps       -> packageFlagErr dflags flag ps
389          Right (ps,qs) -> return (map hide ps ++ qs)
390           where hide p = p {exposed=False}
391
392     -- we trust all matching packages. Maybe should only trust first one?
393     -- and leave others the same or set them untrusted
394     TrustPackage str ->
395        case selectPackages (matchingStr str) pkgs unusable of
396          Left ps       -> packageFlagErr dflags flag ps
397          Right (ps,qs) -> return (map trust ps ++ qs)
398           where trust p = p {trusted=True}
399
400     DistrustPackage str ->
401        case selectPackages (matchingStr str) pkgs unusable of
402          Left ps       -> packageFlagErr dflags flag ps
403          Right (ps,qs) -> return (map distrust ps ++ qs)
404           where distrust p = p {trusted=False}
405
406     _ -> panic "applyPackageFlag"
407
408    where
409         -- When a package is requested to be exposed, we hide all other
410         -- packages with the same name if -hide-all-packages was not specified.
411         -- If it was specified, we expect users to not try to expose a package
412         -- multiple times, so don't hide things.
413         hideAll name ps = map maybe_hide ps
414           where maybe_hide p
415                    | gopt Opt_HideAllPackages dflags     = p
416                    | pkgName (sourcePackageId p) == name = p {exposed=False}
417                    | otherwise                           = p
418
419
420 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
421                -> UnusablePackages
422                -> Either [(PackageConfig, UnusablePackageReason)]
423                   ([PackageConfig], [PackageConfig])
424 selectPackages matches pkgs unusable
425   = let
426         (ps,rest) = partition matches pkgs
427         reasons = [ (p, Map.lookup (installedPackageId p) unusable)
428                   | p <- ps ]
429     in
430     if all (isJust.snd) reasons
431        then Left  [ (p, reason) | (p,Just reason) <- reasons ]
432        else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
433
434 -- A package named on the command line can either include the
435 -- version, or just the name if it is unambiguous.
436 matchingStr :: String -> PackageConfig -> Bool
437 matchingStr str p
438         =  str == display (sourcePackageId p)
439         || str == display (pkgName (sourcePackageId p))
440
441 matchingId :: String -> PackageConfig -> Bool
442 matchingId str p =  InstalledPackageId str == installedPackageId p
443
444 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
445 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
446
447 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
448 comparing f a b = f a `compare` f b
449
450 packageFlagErr :: DynFlags
451                -> PackageFlag
452                -> [(PackageConfig, UnusablePackageReason)]
453                -> IO a
454
455 -- for missing DPH package we emit a more helpful error message, because
456 -- this may be the result of using -fdph-par or -fdph-seq.
457 packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
458   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
459   where dph_err = text "the " <> text pkg <> text " package is not installed."
460                   $$ text "To install it: \"cabal install dph\"."
461         is_dph_package pkg = "dph" `isPrefixOf` pkg
462
463 packageFlagErr dflags flag reasons
464   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
465   where err = text "cannot satisfy " <> ppr_flag <>
466                 (if null reasons then empty else text ": ") $$
467               nest 4 (ppr_reasons $$
468                       text "(use -v for more information)")
469         ppr_flag = case flag of
470                      IgnorePackage p -> text "-ignore-package " <> text p
471                      HidePackage p   -> text "-hide-package " <> text p
472                      ExposePackage p -> text "-package " <> text p
473                      ExposePackageId p -> text "-package-id " <> text p
474                      TrustPackage p    -> text "-trust " <> text p
475                      DistrustPackage p -> text "-distrust " <> text p
476         ppr_reasons = vcat (map ppr_reason reasons)
477         ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
478
479 -- -----------------------------------------------------------------------------
480 -- Hide old versions of packages
481
482 --
483 -- hide all packages for which there is also a later version
484 -- that is already exposed.  This just makes it non-fatal to have two
485 -- versions of a package exposed, which can happen if you install a
486 -- later version of a package in the user database, for example.
487 -- However, don't do this if @-hide-all-packages@ was passed.
488 --
489 hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
490 hideOldPackages dflags pkgs = mapM maybe_hide pkgs
491   where maybe_hide p
492            | gopt Opt_HideAllPackages dflags = return p
493            | not (exposed p) = return p
494            | (p' : _) <- later_versions = do
495                 debugTraceMsg dflags 2 $
496                    (ptext (sLit "hiding package") <+> pprSPkg p <+>
497                     ptext (sLit "to avoid conflict with later version") <+>
498                     pprSPkg p')
499                 return (p {exposed=False})
500            | otherwise = return p
501           where myname = pkgName (sourcePackageId p)
502                 myversion = pkgVersion (sourcePackageId p)
503                 later_versions = [ p | p <- pkgs, exposed p,
504                                        let pkg = sourcePackageId p,
505                                        pkgName pkg == myname,
506                                        pkgVersion pkg > myversion ]
507
508 -- -----------------------------------------------------------------------------
509 -- Wired-in packages
510
511 findWiredInPackages
512    :: DynFlags
513    -> [PackageConfig]           -- database
514    -> IO [PackageConfig]
515
516 findWiredInPackages dflags pkgs = do
517   --
518   -- Now we must find our wired-in packages, and rename them to
519   -- their canonical names (eg. base-1.0 ==> base).
520   --
521   let
522         wired_in_pkgids :: [String]
523         wired_in_pkgids = map packageKeyString
524                           [ primPackageKey,
525                             integerPackageKey,
526                             basePackageKey,
527                             rtsPackageKey,
528                             thPackageKey,
529                             thisGhcPackageKey,
530                             dphSeqPackageKey,
531                             dphParPackageKey ]
532
533         matches :: PackageConfig -> String -> Bool
534         pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
535
536         -- find which package corresponds to each wired-in package
537         -- delete any other packages with the same name
538         -- update the package and any dependencies to point to the new
539         -- one.
540         --
541         -- When choosing which package to map to a wired-in package
542         -- name, we prefer exposed packages, and pick the latest
543         -- version.  To override the default choice, -hide-package
544         -- could be used to hide newer versions.
545         --
546         findWiredInPackage :: [PackageConfig] -> String
547                            -> IO (Maybe InstalledPackageId)
548         findWiredInPackage pkgs wired_pkg =
549            let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
550            case all_ps of
551                 []   -> notfound
552                 many -> pick (head (sortByVersion many))
553           where
554                 notfound = do
555                           debugTraceMsg dflags 2 $
556                             ptext (sLit "wired-in package ")
557                                  <> text wired_pkg
558                                  <> ptext (sLit " not found.")
559                           return Nothing
560                 pick :: InstalledPackageInfo_ ModuleName
561                      -> IO (Maybe InstalledPackageId)
562                 pick pkg = do
563                         debugTraceMsg dflags 2 $
564                             ptext (sLit "wired-in package ")
565                                  <> text wired_pkg
566                                  <> ptext (sLit " mapped to ")
567                                  <> pprIPkg pkg
568                         return (Just (installedPackageId pkg))
569
570
571   mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
572   let
573         wired_in_ids = catMaybes mb_wired_in_ids
574
575         -- this is old: we used to assume that if there were
576         -- multiple versions of wired-in packages installed that
577         -- they were mutually exclusive.  Now we're assuming that
578         -- you have one "main" version of each wired-in package
579         -- (the latest version), and the others are backward-compat
580         -- wrappers that depend on this one.  e.g. base-4.0 is the
581         -- latest, base-3.0 is a compat wrapper depending on base-4.0.
582         {-
583         deleteOtherWiredInPackages pkgs = filterOut bad pkgs
584           where bad p = any (p `matches`) wired_in_pkgids
585                       && package p `notElem` map fst wired_in_ids
586         -}
587
588         updateWiredInDependencies pkgs = map upd_pkg pkgs
589           where upd_pkg p
590                   | installedPackageId p `elem` wired_in_ids
591                   = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
592                   | otherwise
593                   = p
594
595   return $ updateWiredInDependencies pkgs
596
597 -- ----------------------------------------------------------------------------
598
599 data UnusablePackageReason
600   = IgnoredWithFlag
601   | MissingDependencies [InstalledPackageId]
602   | ShadowedBy InstalledPackageId
603
604 type UnusablePackages = Map InstalledPackageId UnusablePackageReason
605
606 pprReason :: SDoc -> UnusablePackageReason -> SDoc
607 pprReason pref reason = case reason of
608   IgnoredWithFlag ->
609       pref <+> ptext (sLit "ignored due to an -ignore-package flag")
610   MissingDependencies deps ->
611       pref <+>
612       ptext (sLit "unusable due to missing or recursive dependencies:") $$
613         nest 2 (hsep (map (text.display) deps))
614   ShadowedBy ipid ->
615       pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
616
617 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
618 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
619   where
620     report (ipid, reason) =
621        debugTraceMsg dflags 2 $
622          pprReason
623            (ptext (sLit "package") <+>
624             text (display ipid) <+> text "is") reason
625
626 -- ----------------------------------------------------------------------------
627 --
628 -- Detect any packages that have missing dependencies, and also any
629 -- mutually-recursive groups of packages (loops in the package graph
630 -- are not allowed).  We do this by taking the least fixpoint of the
631 -- dependency graph, repeatedly adding packages whose dependencies are
632 -- satisfied until no more can be added.
633 --
634 findBroken :: [PackageConfig] -> UnusablePackages
635 findBroken pkgs = go [] Map.empty pkgs
636  where
637    go avail ipids not_avail =
638      case partitionWith (depsAvailable ipids) not_avail of
639         ([], not_avail) ->
640             Map.fromList [ (installedPackageId p, MissingDependencies deps)
641                          | (p,deps) <- not_avail ]
642         (new_avail, not_avail) ->
643             go (new_avail ++ avail) new_ipids (map fst not_avail)
644             where new_ipids = Map.insertList
645                                 [ (installedPackageId p, p) | p <- new_avail ]
646                                 ipids
647
648    depsAvailable :: InstalledPackageIndex
649                  -> PackageConfig
650                  -> Either PackageConfig (PackageConfig, [InstalledPackageId])
651    depsAvailable ipids pkg
652         | null dangling = Left pkg
653         | otherwise     = Right (pkg, dangling)
654         where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
655
656 -- -----------------------------------------------------------------------------
657 -- Eliminate shadowed packages, giving the user some feedback
658
659 -- later packages in the list should shadow earlier ones with the same
660 -- package name/version.  Additionally, a package may be preferred if
661 -- it is in the transitive closure of packages selected using -package-id
662 -- flags.
663 shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
664 shadowPackages pkgs preferred
665  = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
666    in  Map.fromList shadowed
667  where
668  check (shadowed,pkgmap) pkg
669       | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
670       , let
671             ipid_new = installedPackageId pkg
672             ipid_old = installedPackageId oldpkg
673         --
674       , ipid_old /= ipid_new
675       = if ipid_old `elem` preferred
676            then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
677            else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
678       | otherwise
679       = (shadowed, pkgmap')
680       where
681         pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
682
683 -- -----------------------------------------------------------------------------
684
685 ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
686 ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
687   where
688   doit (IgnorePackage str) =
689      case partition (matchingStr str) pkgs of
690          (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
691                     | p <- ps ]
692         -- missing package is not an error for -ignore-package,
693         -- because a common usage is to -ignore-package P as
694         -- a preventative measure just in case P exists.
695   doit _ = panic "ignorePackages"
696
697 -- -----------------------------------------------------------------------------
698
699 depClosure :: InstalledPackageIndex
700            -> [InstalledPackageId]
701            -> [InstalledPackageId]
702 depClosure index ipids = closure Map.empty ipids
703   where
704    closure set [] = Map.keys set
705    closure set (ipid : ipids)
706      | ipid `Map.member` set = closure set ipids
707      | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
708                                                  (depends p ++ ipids)
709      | otherwise = closure set ipids
710
711 -- -----------------------------------------------------------------------------
712 -- When all the command-line options are in, we can process our package
713 -- settings and populate the package state.
714
715 mkPackageState
716     :: DynFlags
717     -> [PackageConfig]          -- initial database
718     -> [PackageKey]              -- preloaded packages
719     -> PackageKey                -- this package
720     -> IO (PackageState,
721            [PackageKey],         -- new packages to preload
722            PackageKey) -- this package, might be modified if the current
723                       -- package is a wired-in package.
724
725 mkPackageState dflags pkgs0 preload0 this_package = do
726
727 {-
728    Plan.
729
730    1. P = transitive closure of packages selected by -package-id
731
732    2. Apply shadowing.  When there are multiple packages with the same
733       sourcePackageId,
734         * if one is in P, use that one
735         * otherwise, use the one highest in the package stack
736       [
737        rationale: we cannot use two packages with the same sourcePackageId
738        in the same program, because sourcePackageId is the symbol prefix.
739        Hence we must select a consistent set of packages to use.  We have
740        a default algorithm for doing this: packages higher in the stack
741        shadow those lower down.  This default algorithm can be overriden
742        by giving explicit -package-id flags; then we have to take these
743        preferences into account when selecting which other packages are
744        made available.
745
746        Our simple algorithm throws away some solutions: there may be other
747        consistent sets that would satisfy the -package flags, but it's
748        not GHC's job to be doing constraint solving.
749       ]
750
751    3. remove packages selected by -ignore-package
752
753    4. remove any packages with missing dependencies, or mutually recursive
754       dependencies.
755
756    5. report (with -v) any packages that were removed by steps 2-4
757
758    6. apply flags to set exposed/hidden on the resulting packages
759       - if any flag refers to a package which was removed by 2-4, then
760         we can give an error message explaining why
761
762    7. hide any packages which are superseded by later exposed packages
763 -}
764
765   let
766       flags = reverse (packageFlags dflags)
767
768       -- pkgs0 with duplicate packages filtered out.  This is
769       -- important: it is possible for a package in the global package
770       -- DB to have the same IPID as a package in the user DB, and
771       -- we want the latter to take precedence.  This is not the same
772       -- as shadowing (below), since in this case the two packages
773       -- have the same ABI and are interchangeable.
774       --
775       -- #4072: note that we must retain the ordering of the list here
776       -- so that shadowing behaves as expected when we apply it later.
777       pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
778           where del p (s,ps)
779                   | pid `Set.member` s = (s,ps)
780                   | otherwise          = (Set.insert pid s, p:ps)
781                   where pid = installedPackageId p
782           -- XXX this is just a variant of nub
783
784       ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
785
786       ipid_selected = depClosure ipid_map [ InstalledPackageId i
787                                           | ExposePackageId i <- flags ]
788
789       (ignore_flags, other_flags) = partition is_ignore flags
790       is_ignore IgnorePackage{} = True
791       is_ignore _ = False
792
793       shadowed = shadowPackages pkgs0_unique ipid_selected
794
795       ignored  = ignorePackages ignore_flags pkgs0_unique
796
797       pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
798       broken   = findBroken pkgs0'
799       unusable = shadowed `Map.union` ignored `Map.union` broken
800
801   reportUnusable dflags unusable
802
803   --
804   -- Modify the package database according to the command-line flags
805   -- (-package, -hide-package, -ignore-package, -hide-all-packages).
806   --
807   pkgs1 <- foldM (applyPackageFlag dflags unusable) pkgs0_unique other_flags
808   let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
809
810   -- Here we build up a set of the packages mentioned in -package
811   -- flags on the command line; these are called the "preload"
812   -- packages.  we link these packages in eagerly.  The preload set
813   -- should contain at least rts & base, which is why we pretend that
814   -- the command line contains -package rts & -package base.
815   --
816   let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
817
818       get_exposed (ExposePackage   s)
819          = take 1 $ sortByVersion (filter (matchingStr s) pkgs2)
820          --  -package P means "the latest version of P" (#7030)
821       get_exposed (ExposePackageId s) = filter (matchingId  s) pkgs2
822       get_exposed _                   = []
823
824   -- hide packages that are subsumed by later versions
825   pkgs3 <- hideOldPackages dflags pkgs2
826
827   -- sort out which packages are wired in
828   pkgs4 <- findWiredInPackages dflags pkgs3
829
830   let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
831
832       ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
833                               | p <- pkgs4 ]
834
835       lookupIPID ipid@(InstalledPackageId str)
836          | Just pid <- Map.lookup ipid ipid_map = return pid
837          | otherwise                            = missingPackageErr dflags str
838
839   preload2 <- mapM lookupIPID preload1
840
841   let
842       -- add base & rts to the preload packages
843       basicLinkedPackages
844        | gopt Opt_AutoLinkPackages dflags
845           = filter (flip elemUFM pkg_db) [basePackageKey, rtsPackageKey]
846        | otherwise = []
847       -- but in any case remove the current package from the set of
848       -- preloaded packages so that base/rts does not end up in the
849       -- set up preloaded package when we are just building it
850       preload3 = nub $ filter (/= this_package)
851                      $ (basicLinkedPackages ++ preload2)
852
853   -- Close the preload packages with their dependencies
854   dep_preload <- closeDeps dflags pkg_db ipid_map (zip preload3 (repeat Nothing))
855   let new_dep_preload = filter (`notElem` preload0) dep_preload
856
857   let pstate = PackageState{ preloadPackages     = dep_preload,
858                              pkgIdMap            = pkg_db,
859                              moduleToPkgConfAll  = mkModuleMap pkg_db ipid_map,
860                              installedPackageIdMap = ipid_map
861                            }
862
863   return (pstate, new_dep_preload, this_package)
864
865
866 -- -----------------------------------------------------------------------------
867 -- | Makes the mapping from module to package info for 'moduleToPkgConfAll'
868
869 mkModuleMap
870   :: PackageConfigMap
871   -> InstalledPackageIdMap
872   -> ModuleToPkgConfAll
873 mkModuleMap pkg_db ipid_map = foldr extend_modmap emptyUFM pkgids
874   where
875     pkgids = map packageConfigId (eltsUFM pkg_db)
876
877     extend_modmap pkgid modmap = addListToUFM_C (plusUFM_C merge) modmap es
878       where -- Invariant: m == m' && pkg == pkg' && e == e'
879             --              && (e || not (v || v'))
880             -- Some notes about the assert. Merging only ever occurs when
881             -- we find a reexport.  The interesting condition:
882             --      e || not (v || v')
883             -- says that a non-exposed module cannot ever become visible.
884             -- However, an invisible (but exported) module may become
885             -- visible when it is reexported by a visible package,
886             -- which is why we merge visibility using logical OR.
887             merge a b = a { modConfVisible =
888                                    modConfVisible a || modConfVisible b }
889             es = [(m, unitUFM pkgid  (ModConf m pkg True (exposed pkg)))
890                  | m <- exposed_mods] ++
891                  [(m, unitUFM pkgid  (ModConf m pkg False False))
892                  | m <- hidden_mods] ++
893                  [(m, unitUFM pkgid' (ModConf m' pkg' True (exposed pkg)))
894                  | ModuleExport{ exportName = m
895                                , exportCachedTrueOrig = Just (ipid', m')}
896                         <- reexported_mods
897                  , Just pkgid' <- [Map.lookup ipid' ipid_map]
898                  , let pkg' = pkg_lookup pkgid' ]
899             pkg = pkg_lookup pkgid
900             pkg_lookup = expectJust "mkModuleMap" . lookupPackage pkg_db
901             exposed_mods = exposedModules pkg
902             reexported_mods = reexportedModules pkg
903             hidden_mods  = hiddenModules pkg
904
905 pprSPkg :: PackageConfig -> SDoc
906 pprSPkg p = text (display (sourcePackageId p))
907
908 pprIPkg :: PackageConfig -> SDoc
909 pprIPkg p = text (display (installedPackageId p))
910
911 -- -----------------------------------------------------------------------------
912 -- Extracting information from the packages in scope
913
914 -- Many of these functions take a list of packages: in those cases,
915 -- the list is expected to contain the "dependent packages",
916 -- i.e. those packages that were found to be depended on by the
917 -- current module/program.  These can be auto or non-auto packages, it
918 -- doesn't really matter.  The list is always combined with the list
919 -- of preload (command-line) packages to determine which packages to
920 -- use.
921
922 -- | Find all the include directories in these and the preload packages
923 getPackageIncludePath :: DynFlags -> [PackageKey] -> IO [String]
924 getPackageIncludePath dflags pkgs =
925   collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
926
927 collectIncludeDirs :: [PackageConfig] -> [FilePath]
928 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
929
930 -- | Find all the library paths in these and the preload packages
931 getPackageLibraryPath :: DynFlags -> [PackageKey] -> IO [String]
932 getPackageLibraryPath dflags pkgs =
933   collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
934
935 collectLibraryPaths :: [PackageConfig] -> [FilePath]
936 collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
937
938 -- | Find all the link options in these and the preload packages,
939 -- returning (package hs lib options, extra library options, other flags)
940 getPackageLinkOpts :: DynFlags -> [PackageKey] -> IO ([String], [String], [String])
941 getPackageLinkOpts dflags pkgs =
942   collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
943
944 collectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])
945 collectLinkOpts dflags ps =
946     (
947         concatMap (map ("-l" ++) . packageHsLibs dflags) ps,
948         concatMap (map ("-l" ++) . extraLibraries) ps,
949         concatMap ldOptions ps
950     )
951
952 packageHsLibs :: DynFlags -> PackageConfig -> [String]
953 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
954   where
955         ways0 = ways dflags
956
957         ways1 = filter (/= WayDyn) ways0
958         -- the name of a shared library is libHSfoo-ghc<version>.so
959         -- we leave out the _dyn, because it is superfluous
960
961         -- debug RTS includes support for -eventlog
962         ways2 | WayDebug `elem` ways1
963               = filter (/= WayEventLog) ways1
964               | otherwise
965               = ways1
966
967         tag     = mkBuildTag (filter (not . wayRTSOnly) ways2)
968         rts_tag = mkBuildTag ways2
969
970         mkDynName x
971          | gopt Opt_Static dflags       = x
972          | "HS" `isPrefixOf` x          = x ++ "-ghc" ++ cProjectVersion
973            -- For non-Haskell libraries, we use the name "Cfoo". The .a
974            -- file is libCfoo.a, and the .so is libfoo.so. That way the
975            -- linker knows what we mean for the vanilla (-lCfoo) and dyn
976            -- (-lfoo) ways. We therefore need to strip the 'C' off here.
977          | Just x' <- stripPrefix "C" x = x'
978          | otherwise
979             = panic ("Don't understand library name " ++ x)
980
981         addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)
982         addSuffix other_lib      = other_lib ++ (expandTag tag)
983
984         expandTag t | null t = ""
985                     | otherwise = '_':t
986
987 -- | Find all the C-compiler options in these and the preload packages
988 getPackageExtraCcOpts :: DynFlags -> [PackageKey] -> IO [String]
989 getPackageExtraCcOpts dflags pkgs = do
990   ps <- getPreloadPackagesAnd dflags pkgs
991   return (concatMap ccOptions ps)
992
993 -- | Find all the package framework paths in these and the preload packages
994 getPackageFrameworkPath  :: DynFlags -> [PackageKey] -> IO [String]
995 getPackageFrameworkPath dflags pkgs = do
996   ps <- getPreloadPackagesAnd dflags pkgs
997   return (nub (filter notNull (concatMap frameworkDirs ps)))
998
999 -- | Find all the package frameworks in these and the preload packages
1000 getPackageFrameworks  :: DynFlags -> [PackageKey] -> IO [String]
1001 getPackageFrameworks dflags pkgs = do
1002   ps <- getPreloadPackagesAnd dflags pkgs
1003   return (concatMap frameworks ps)
1004
1005 -- -----------------------------------------------------------------------------
1006 -- Package Utils
1007
1008 -- | Takes a 'ModuleName', and if the module is in any package returns
1009 -- a map of package IDs to 'ModuleConf', describing where the module lives
1010 -- and whether or not it is exposed.
1011 lookupModuleInAllPackages :: DynFlags
1012                           -> ModuleName
1013                           -> PackageIdMap ModuleConf
1014 lookupModuleInAllPackages dflags m
1015   = case lookupModuleWithSuggestions dflags m of
1016       Right pbs -> pbs
1017       Left  _   -> emptyUFM
1018
1019 lookupModuleWithSuggestions
1020   :: DynFlags -> ModuleName
1021   -> Either [Module] (PackageIdMap ModuleConf)
1022          -- Lookup module in all packages
1023          -- Right pbs   =>   found in pbs
1024          -- Left  ms    =>   not found; but here are sugestions
1025 lookupModuleWithSuggestions dflags m
1026   = case lookupUFM (moduleToPkgConfAll pkg_state) m of
1027         Nothing -> Left suggestions
1028         Just ps -> Right ps
1029   where
1030     pkg_state = pkgState dflags
1031     suggestions
1032       | gopt Opt_HelpfulErrors dflags =
1033            fuzzyLookup (moduleNameString m) all_mods
1034       | otherwise = []
1035
1036     all_mods :: [(String, Module)]     -- All modules
1037     all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
1038                | pkg_config <- eltsUFM (pkgIdMap pkg_state)
1039                , let pkg_id = packageConfigId pkg_config
1040                , mod_nm <- exposedModules pkg_config
1041                         ++ map exportName (reexportedModules pkg_config) ]
1042
1043 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
1044 -- 'PackageConfig's
1045 getPreloadPackagesAnd :: DynFlags -> [PackageKey] -> IO [PackageConfig]
1046 getPreloadPackagesAnd dflags pkgids =
1047   let
1048       state   = pkgState dflags
1049       pkg_map = pkgIdMap state
1050       ipid_map = installedPackageIdMap state
1051       preload = preloadPackages state
1052       pairs = zip pkgids (repeat Nothing)
1053   in do
1054   all_pkgs <- throwErr dflags (foldM (add_package pkg_map ipid_map) preload pairs)
1055   return (map (getPackageDetails state) all_pkgs)
1056
1057 -- Takes a list of packages, and returns the list with dependencies included,
1058 -- in reverse dependency order (a package appears before those it depends on).
1059 closeDeps :: DynFlags
1060           -> PackageConfigMap
1061           -> Map InstalledPackageId PackageKey
1062           -> [(PackageKey, Maybe PackageKey)]
1063           -> IO [PackageKey]
1064 closeDeps dflags pkg_map ipid_map ps
1065     = throwErr dflags (closeDepsErr pkg_map ipid_map ps)
1066
1067 throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
1068 throwErr dflags m
1069               = case m of
1070                 Failed e    -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))
1071                 Succeeded r -> return r
1072
1073 closeDepsErr :: PackageConfigMap
1074              -> Map InstalledPackageId PackageKey
1075              -> [(PackageKey,Maybe PackageKey)]
1076              -> MaybeErr MsgDoc [PackageKey]
1077 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
1078
1079 -- internal helper
1080 add_package :: PackageConfigMap
1081             -> Map InstalledPackageId PackageKey
1082             -> [PackageKey]
1083             -> (PackageKey,Maybe PackageKey)
1084             -> MaybeErr MsgDoc [PackageKey]
1085 add_package pkg_db ipid_map ps (p, mb_parent)
1086   | p `elem` ps = return ps     -- Check if we've already added this package
1087   | otherwise =
1088       case lookupPackage pkg_db p of
1089         Nothing -> Failed (missingPackageMsg (packageKeyString p) <>
1090                            missingDependencyMsg mb_parent)
1091         Just pkg -> do
1092            -- Add the package's dependents also
1093            ps' <- foldM add_package_ipid ps (depends pkg)
1094            return (p : ps')
1095           where
1096             add_package_ipid ps ipid@(InstalledPackageId str)
1097               | Just pid <- Map.lookup ipid ipid_map
1098               = add_package pkg_db ipid_map ps (pid, Just p)
1099               | otherwise
1100               = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
1101
1102 missingPackageErr :: DynFlags -> String -> IO a
1103 missingPackageErr dflags p
1104     = throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
1105
1106 missingPackageMsg :: String -> SDoc
1107 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
1108
1109 missingDependencyMsg :: Maybe PackageKey -> SDoc
1110 missingDependencyMsg Nothing = empty
1111 missingDependencyMsg (Just parent)
1112   = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent))
1113
1114 -- -----------------------------------------------------------------------------
1115
1116 -- | Will the 'Name' come from a dynamically linked library?
1117 isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool
1118 -- Despite the "dll", I think this function just means that
1119 -- the synbol comes from another dynamically-linked package,
1120 -- and applies on all platforms, not just Windows
1121 isDllName dflags _this_pkg this_mod name
1122   | gopt Opt_Static dflags = False
1123   | Just mod <- nameModule_maybe name
1124     -- Issue #8696 - when GHC is dynamically linked, it will attempt
1125     -- to load the dynamic dependencies of object files at compile
1126     -- time for things like QuasiQuotes or
1127     -- TemplateHaskell. Unfortunately, this interacts badly with
1128     -- intra-package linking, because we don't generate indirect
1129     -- (dynamic) symbols for intra-package calls. This means that if a
1130     -- module with an intra-package call is loaded without its
1131     -- dependencies, then GHC fails to link. This is the cause of #
1132     --
1133     -- In the mean time, always force dynamic indirections to be
1134     -- generated: when the module name isn't the module being
1135     -- compiled, references are dynamic.
1136     = if mod /= this_mod
1137       then True
1138       else case dllSplit dflags of
1139            Nothing -> False
1140            Just ss ->
1141                let findMod m = let modStr = moduleNameString (moduleName m)
1142                                in case find (modStr `Set.member`) ss of
1143                                   Just i -> i
1144                                   Nothing -> panic ("Can't find " ++ modStr ++ "in DLL split")
1145                in findMod mod /= findMod this_mod
1146        
1147   | otherwise = False  -- no, it is not even an external name
1148
1149 -- -----------------------------------------------------------------------------
1150 -- Displaying packages
1151
1152 -- | Show (very verbose) package info on console, if verbosity is >= 5
1153 dumpPackages :: DynFlags -> IO ()
1154 dumpPackages = dumpPackages' showInstalledPackageInfo
1155
1156 dumpPackages' :: (InstalledPackageInfo -> String) -> DynFlags -> IO ()
1157 dumpPackages' showIPI dflags
1158   = do let pkg_map = pkgIdMap (pkgState dflags)
1159        putMsg dflags $
1160              vcat (map (text . showIPI
1161                              . packageConfigToInstalledPackageInfo)
1162                        (eltsUFM pkg_map))
1163
1164 -- | Show simplified package info on console, if verbosity == 4.
1165 -- The idea is to only print package id, and any information that might
1166 -- be different from the package databases (exposure, trust)
1167 simpleDumpPackages :: DynFlags -> IO ()
1168 simpleDumpPackages = dumpPackages' showIPI
1169     where showIPI ipi = let InstalledPackageId i = installedPackageId ipi
1170                             e = if exposed ipi then "E" else " "
1171                             t = if trusted ipi then "T" else " "
1172                         in e ++ t ++ "  " ++ i
1173
1174 \end{code}