compiler/ghci/Linker.lhs

   1 %
   2 % (c) The University of Glasgow 2005-2006
   3 %
   4
   5 -- --------------------------------------
   6 --      The dynamic linker for GHCi
   7 -- --------------------------------------
   8
   9 This module deals with the top-level issues of dynamic linking,
  10 calling the object-code linker and the byte-code linker where
  11 necessary.
  12
  13
  14 \begin{code}
  15 {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
  16
  17 {-# OPTIONS -fno-cse #-}
  18 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
  19
  20 module Linker ( HValue, getHValue, showLinkerState,
  21                 linkExpr, unload, withExtendedLinkEnv,
  22                 extendLinkEnv, deleteFromLinkEnv,
  23                 extendLoadedPkgs,
  24                 linkPackages,initDynLinker,
  25                 dataConInfoPtrToName
  26         ) where
  27
  28 #include "HsVersions.h"
  29
  30 import LoadIface
  31 import ObjLink
  32 import ByteCodeLink
  33 import ByteCodeItbls
  34 import ByteCodeAsm
  35 import CgInfoTbls
  36 import SMRep
  37 import IfaceEnv
  38 import TcRnMonad
  39 import Packages
  40 import DriverPhases
  41 import Finder
  42 import HscTypes
  43 import Name
  44 import NameEnv
  45 import NameSet
  46 import qualified OccName
  47 import LazyUniqFM
  48 import Module
  49 import ListSetOps
  50 import DynFlags
  51 import BasicTypes
  52 import Outputable
  53 import PackageConfig
  54 import Panic
  55 import Util
  56 import StaticFlags
  57 import ErrUtils
  58 import DriverPhases
  59 import SrcLoc
  60 import qualified Maybes
  61 import UniqSet
  62 import Constants
  63 import FastString
  64 import Config           ( cProjectVersion )
  65
  66 -- Standard libraries
  67 import Control.Monad
  68
  69 import Data.Char
  70 import Data.IORef
  71 import Data.List
  72 import Foreign
  73
  74 import System.FilePath
  75 import System.IO
  76 import System.Directory
  77
  78 import Distribution.Package hiding (depends)
  79
  80 import Exception
  81 import Data.Maybe
  82 \end{code}
  83
  84
  85 %************************************************************************
  86 %*                                                                      *
  87                         The Linker's state
  88 %*                                                                      *
  89 %************************************************************************
  90
  91 The persistent linker state *must* match the actual state of the
  92 C dynamic linker at all times, so we keep it in a private global variable.
  93
  94
  95 The PersistentLinkerState maps Names to actual closures (for
  96 interpreted code only), for use during linking.
  97
  98 \begin{code}
  99 GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
 100 GLOBAL_VAR(v_InitLinkerDone, False, Bool)       -- Set True when dynamic linker is initialised
 101
 102 data PersistentLinkerState
 103    = PersistentLinkerState {
 104
 105         -- Current global mapping from Names to their true values
 106         closure_env :: ClosureEnv,
 107
 108         -- The current global mapping from RdrNames of DataCons to
 109         -- info table addresses.
 110         -- When a new Unlinked is linked into the running image, or an existing
 111         -- module in the image is replaced, the itbl_env must be updated
 112         -- appropriately.
 113         itbl_env    :: ItblEnv,
 114
 115         -- The currently loaded interpreted modules (home package)
 116         bcos_loaded :: [Linkable],
 117
 118         -- And the currently-loaded compiled modules (home package)
 119         objs_loaded :: [Linkable],
 120
 121         -- The currently-loaded packages; always object code
 122         -- Held, as usual, in dependency order; though I am not sure if
 123         -- that is really important
 124         pkgs_loaded :: [PackageId]
 125      }
 126
 127 emptyPLS :: DynFlags -> PersistentLinkerState
 128 emptyPLS _ = PersistentLinkerState {
 129                         closure_env = emptyNameEnv,
 130                         itbl_env    = emptyNameEnv,
 131                         pkgs_loaded = init_pkgs,
 132                         bcos_loaded = [],
 133                         objs_loaded = [] }
 134
 135   -- Packages that don't need loading, because the compiler
 136   -- shares them with the interpreted program.
 137   --
 138   -- The linker's symbol table is populated with RTS symbols using an
 139   -- explicit list.  See rts/Linker.c for details.
 140   where init_pkgs = [rtsPackageId]
 141 \end{code}
 142
 143 \begin{code}
 144 extendLoadedPkgs :: [PackageId] -> IO ()
 145 extendLoadedPkgs pkgs
 146     = modifyIORef v_PersistentLinkerState (\s -> s{pkgs_loaded = pkgs ++ pkgs_loaded s})
 147
 148 extendLinkEnv :: [(Name,HValue)] -> IO ()
 149 -- Automatically discards shadowed bindings
 150 extendLinkEnv new_bindings
 151   = do  pls <- readIORef v_PersistentLinkerState
 152         let new_closure_env = extendClosureEnv (closure_env pls) new_bindings
 153             new_pls = pls { closure_env = new_closure_env }
 154         writeIORef v_PersistentLinkerState new_pls
 155
 156 deleteFromLinkEnv :: [Name] -> IO ()
 157 deleteFromLinkEnv to_remove
 158   = do  pls <- readIORef v_PersistentLinkerState
 159         let new_closure_env = delListFromNameEnv (closure_env pls) to_remove
 160             new_pls = pls { closure_env = new_closure_env }
 161         writeIORef v_PersistentLinkerState new_pls
 162
 163 -- | Given a data constructor in the heap, find its Name.
 164 --   The info tables for data constructors have a field which records
 165 --   the source name of the constructor as a Ptr Word8 (UTF-8 encoded
 166 --   string). The format is:
 167 --
 168 --    Package:Module.Name
 169 --
 170 --   We use this string to lookup the interpreter's internal representation of the name
 171 --   using the lookupOrig.
 172
 173 dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
 174 dataConInfoPtrToName x = do
 175    theString <- liftIO $ do
 176       let ptr = castPtr x :: Ptr StgInfoTable
 177       conDescAddress <- getConDescAddress ptr
 178       peekArray0 0 conDescAddress
 179    let (pkg, mod, occ) = parse theString
 180        pkgFS = mkFastStringByteList pkg
 181        modFS = mkFastStringByteList mod
 182        occFS = mkFastStringByteList occ
 183        occName = mkOccNameFS OccName.dataName occFS
 184        modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS)
 185    return (Left$ showSDoc$ ppr modName <> dot <> ppr occName )
 186     `recoverM` (Right `fmap` lookupOrig modName occName)
 187
 188    where
 189
 190    {- To find the string in the constructor's info table we need to consider
 191       the layout of info tables relative to the entry code for a closure.
 192
 193       An info table can be next to the entry code for the closure, or it can
 194       be separate. The former (faster) is used in registerised versions of ghc,
 195       and the latter (portable) is for non-registerised versions.
 196
 197       The diagrams below show where the string is to be found relative to
 198       the normal info table of the closure.
 199
 200       1) Code next to table:
 201
 202          --------------
 203          |            |   <- pointer to the start of the string
 204          --------------
 205          |            |   <- the (start of the) info table structure
 206          |            |
 207          |            |
 208          --------------
 209          | entry code |
 210          |    ....    |
 211
 212          In this case the pointer to the start of the string can be found in
 213          the memory location _one word before_ the first entry in the normal info
 214          table.
 215
 216       2) Code NOT next to table:
 217
 218                                  --------------
 219          info table structure -> |     *------------------> --------------
 220                                  |            |             | entry code |
 221                                  |            |             |    ....    |
 222                                  --------------
 223          ptr to start of str ->  |            |
 224                                  --------------
 225
 226          In this case the pointer to the start of the string can be found
 227          in the memory location: info_table_ptr + info_table_size
 228    -}
 229
 230    getConDescAddress :: Ptr StgInfoTable -> IO (Ptr Word8)
 231    getConDescAddress ptr
 232     | ghciTablesNextToCode = do
 233        offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
 234        return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord))
 235     | otherwise =
 236        peek $ intPtrToPtr $ (ptrToIntPtr ptr) + fromIntegral stdInfoTableSizeB
 237
 238    -- parsing names is a little bit fiddly because we have a string in the form:
 239    -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
 240    -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
 241    -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
 242    -- this is not the conventional way of writing Haskell names. We stick with
 243    -- convention, even though it makes the parsing code more troublesome.
 244    -- Warning: this code assumes that the string is well formed.
 245    parse :: [Word8] -> ([Word8], [Word8], [Word8])
 246    parse input
 247       = ASSERT (all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
 248       where
 249       dot = fromIntegral (ord '.')
 250       (pkg, rest1) = break (== fromIntegral (ord ':')) input
 251       (mod, occ)
 252          = (concat $ intersperse [dot] $ reverse modWords, occWord)
 253          where
 254          (modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
 255       parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
 256       parseModOcc acc str
 257          = case break (== dot) str of
 258               (top, []) -> (acc, top)
 259               (top, _:bot) -> parseModOcc (top : acc) bot
 260
 261
 262 getHValue :: HscEnv -> Name -> IO HValue
 263 getHValue hsc_env name = do
 264    when (isExternalName name) $ do
 265         ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
 266         when (failed ok) $ ghcError (ProgramError "")
 267    pls <- readIORef v_PersistentLinkerState
 268    lookupName (closure_env pls) name
 269
 270 linkDependencies :: HscEnv -> SrcSpan -> [Module] -> IO SuccessFlag
 271 linkDependencies hsc_env span needed_mods = do
 272    let hpt = hsc_HPT hsc_env
 273        dflags = hsc_dflags hsc_env
 274         -- The interpreter and dynamic linker can only handle object code built
 275         -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
 276         -- So here we check the build tag: if we're building a non-standard way
 277         -- then we need to find & link object files built the "normal" way.
 278    maybe_normal_osuf <- checkNonStdWay dflags span
 279
 280         -- Find what packages and linkables are required
 281    eps <- readIORef (hsc_EPS hsc_env)
 282    (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps)
 283                                 maybe_normal_osuf span needed_mods
 284
 285         -- Link the packages and modules required
 286    linkPackages dflags pkgs
 287    linkModules dflags lnks
 288
 289
 290 -- | Temporarily extend the linker state.
 291
 292 withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
 293 withExtendedLinkEnv new_env action
 294     = bracket_ set_new_env
 295                reset_old_env
 296                action
 297     where set_new_env = do
 298             pls <- readIORef v_PersistentLinkerState
 299             let new_closure_env = extendClosureEnv (closure_env pls) new_env
 300                 new_pls = pls { closure_env = new_closure_env }
 301             writeIORef v_PersistentLinkerState new_pls
 302             return ()
 303
 304         -- Remember that the linker state might be side-effected
 305         -- during the execution of the IO action, and we don't want to
 306         -- lose those changes (we might have linked a new module or
 307         -- package), so the reset action only removes the names we
 308         -- added earlier.
 309           reset_old_env = do
 310             modifyIORef v_PersistentLinkerState $ \pls ->
 311                 let cur = closure_env pls
 312                     new = delListFromNameEnv cur (map fst new_env)
 313                 in
 314                 pls{ closure_env = new }
 315
 316 -- filterNameMap removes from the environment all entries except
 317 --      those for a given set of modules;
 318 -- Note that this removes all *local* (i.e. non-isExternal) names too
 319 --      (these are the temporary bindings from the command line).
 320 -- Used to filter both the ClosureEnv and ItblEnv
 321
 322 filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
 323 filterNameMap mods env
 324    = filterNameEnv keep_elt env
 325    where
 326      keep_elt (n,_) = isExternalName n
 327                       && (nameModule n `elem` mods)
 328 \end{code}
 329
 330
 331 \begin{code}
 332 showLinkerState :: IO ()
 333 -- Display the persistent linker state
 334 showLinkerState
 335   = do pls <- readIORef v_PersistentLinkerState
 336        printDump (vcat [text "----- Linker state -----",
 337                         text "Pkgs:" <+> ppr (pkgs_loaded pls),
 338                         text "Objs:" <+> ppr (objs_loaded pls),
 339                         text "BCOs:" <+> ppr (bcos_loaded pls)])
 340 \end{code}
 341
 342
 343
 344
 345 %************************************************************************
 346 %*                                                                      *
 347 \subsection{Initialisation}
 348 %*                                                                      *
 349 %************************************************************************
 350
 351 We initialise the dynamic linker by
 352
 353 a) calling the C initialisation procedure
 354
 355 b) Loading any packages specified on the command line,
 356
 357 c) Loading any packages specified on the command line,
 358    now held in the -l options in v_Opt_l
 359
 360 d) Loading any .o/.dll files specified on the command line,
 361    now held in v_Ld_inputs
 362
 363 e) Loading any MacOS frameworks
 364
 365 \begin{code}
 366 initDynLinker :: DynFlags -> IO ()
 367 -- This function is idempotent; if called more than once, it does nothing
 368 -- This is useful in Template Haskell, where we call it before trying to link
 369 initDynLinker dflags
 370   = do  { done <- readIORef v_InitLinkerDone
 371         ; if done then return ()
 372                   else do { writeIORef v_InitLinkerDone True
 373                           ; reallyInitDynLinker dflags }
 374         }
 375
 376 reallyInitDynLinker :: DynFlags -> IO ()
 377 reallyInitDynLinker dflags
 378   = do  {  -- Initialise the linker state
 379         ; writeIORef v_PersistentLinkerState (emptyPLS dflags)
 380
 381                 -- (a) initialise the C dynamic linker
 382         ; initObjLinker
 383
 384                 -- (b) Load packages from the command-line
 385         ; linkPackages dflags (preloadPackages (pkgState dflags))
 386
 387                 -- (c) Link libraries from the command-line
 388         ; let optl = getOpts dflags opt_l
 389         ; let minus_ls = [ lib | '-':'l':lib <- optl ]
 390
 391                 -- (d) Link .o files from the command-line
 392         ; let lib_paths = libraryPaths dflags
 393         ; cmdline_ld_inputs <- readIORef v_Ld_inputs
 394
 395         ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
 396
 397                 -- (e) Link any MacOS frameworks
 398         ; let framework_paths
 399                | isDarwinTarget = frameworkPaths dflags
 400                | otherwise      = []
 401         ; let frameworks
 402                | isDarwinTarget = cmdlineFrameworks dflags
 403                | otherwise      = []
 404                 -- Finally do (c),(d),(e)
 405         ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
 406                                ++ map DLL       minus_ls
 407                                ++ map Framework frameworks
 408         ; if null cmdline_lib_specs then return ()
 409                                     else do
 410
 411         { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
 412         ; maybePutStr dflags "final link ... "
 413         ; ok <- resolveObjs
 414
 415         ; if succeeded ok then maybePutStrLn dflags "done"
 416           else ghcError (InstallationError "linking extra libraries/objects failed")
 417         }}
 418
 419 classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
 420 classifyLdInput f
 421   | isObjectFilename f = return (Just (Object f))
 422   | isDynLibFilename f = return (Just (DLLPath f))
 423   | otherwise          = do
 424         hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
 425         return Nothing
 426
 427 preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
 428 preloadLib dflags lib_paths framework_paths lib_spec
 429   = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
 430        case lib_spec of
 431           Object static_ish
 432              -> do b <- preload_static lib_paths static_ish
 433                    maybePutStrLn dflags (if b  then "done"
 434                                                 else "not found")
 435
 436           DLL dll_unadorned
 437              -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
 438                    case maybe_errstr of
 439                       Nothing -> maybePutStrLn dflags "done"
 440                       Just mm -> preloadFailed mm lib_paths lib_spec
 441
 442           DLLPath dll_path
 443              -> do maybe_errstr <- loadDLL dll_path
 444                    case maybe_errstr of
 445                       Nothing -> maybePutStrLn dflags "done"
 446                       Just mm -> preloadFailed mm lib_paths lib_spec
 447
 448           Framework framework
 449            | isDarwinTarget
 450              -> do maybe_errstr <- loadFramework framework_paths framework
 451                    case maybe_errstr of
 452                       Nothing -> maybePutStrLn dflags "done"
 453                       Just mm -> preloadFailed mm framework_paths lib_spec
 454            | otherwise -> panic "preloadLib Framework"
 455
 456   where
 457     preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
 458     preloadFailed sys_errmsg paths spec
 459        = do maybePutStr dflags
 460                ("failed.\nDynamic linker error message was:\n   "
 461                     ++ sys_errmsg  ++ "\nWhilst trying to load:  "
 462                     ++ showLS spec ++ "\nDirectories to search are:\n"
 463                     ++ unlines (map ("   "++) paths) )
 464             give_up
 465
 466     -- Not interested in the paths in the static case.
 467     preload_static _paths name
 468        = do b <- doesFileExist name
 469             if not b then return False
 470                      else loadObj name >> return True
 471
 472     give_up = ghcError $
 473               CmdLineError "user specified .o/.so/.DLL could not be loaded."
 474 \end{code}
 475
 476
 477 %************************************************************************
 478 %*                                                                      *
 479                 Link a byte-code expression
 480 %*                                                                      *
 481 %************************************************************************
 482
 483 \begin{code}
 484 linkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO HValue
 485
 486 -- Link a single expression, *including* first linking packages and
 487 -- modules that this expression depends on.
 488 --
 489 -- Raises an IO exception if it can't find a compiled version of the
 490 -- dependents to link.
 491 --
 492 -- Note: This function side-effects the linker state (Pepe)
 493
 494 linkExpr hsc_env span root_ul_bco
 495   = do {
 496         -- Initialise the linker (if it's not been done already)
 497      let dflags = hsc_dflags hsc_env
 498    ; initDynLinker dflags
 499
 500         -- Link the packages and modules required
 501    ; ok <- linkDependencies hsc_env span needed_mods
 502    ; if failed ok then
 503         ghcError (ProgramError "")
 504      else do {
 505
 506         -- Link the expression itself
 507      pls <- readIORef v_PersistentLinkerState
 508    ; let ie = itbl_env pls
 509          ce = closure_env pls
 510
 511         -- Link the necessary packages and linkables
 512    ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
 513    ; return root_hval
 514    }}
 515    where
 516      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 517
 518      needed_mods :: [Module]
 519      needed_mods = [ nameModule n | n <- free_names,
 520                                     isExternalName n,           -- Names from other modules
 521                                     not (isWiredInName n)       -- Exclude wired-in names
 522                    ]                                            -- (see note below)
 523         -- Exclude wired-in names because we may not have read
 524         -- their interface files, so getLinkDeps will fail
 525         -- All wired-in names are in the base package, which we link
 526         -- by default, so we can safely ignore them here.
 527
 528 dieWith :: SrcSpan -> Message -> IO a
 529 dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
 530
 531
 532 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
 533 checkNonStdWay dflags srcspan = do
 534   tag <- readIORef v_Build_tag
 535   if null tag then return Nothing else do
 536   let default_osuf = phaseInputExt StopLn
 537   if objectSuf dflags == default_osuf
 538         then failNonStd srcspan
 539         else return (Just default_osuf)
 540
 541 failNonStd :: SrcSpan -> IO (Maybe String)
 542 failNonStd srcspan = dieWith srcspan $
 543   ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$
 544   ptext (sLit "You need to build the program twice: once the normal way, and then") $$
 545   ptext (sLit "in the desired way using -osuf to set the object file suffix.")
 546
 547
 548 getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable
 549             -> Maybe String                     -- the "normal" object suffix
 550             -> SrcSpan                          -- for error messages
 551             -> [Module]                         -- If you need these
 552             -> IO ([Linkable], [PackageId])     -- ... then link these first
 553 -- Fails with an IO exception if it can't find enough files
 554
 555 getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
 556 -- Find all the packages and linkables that a set of modules depends on
 557  = do { pls <- readIORef v_PersistentLinkerState ;
 558         -- 1.  Find the dependent home-pkg-modules/packages from each iface
 559         (mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet;
 560
 561         let {
 562         -- 2.  Exclude ones already linked
 563         --      Main reason: avoid findModule calls in get_linkable
 564             mods_needed = mods_s `minusList` linked_mods     ;
 565             pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 566
 567             linked_mods = map (moduleName.linkableModule)
 568                                 (objs_loaded pls ++ bcos_loaded pls)
 569         } ;
 570
 571 --        putStrLn (showSDoc (ppr mods_s)) ;
 572         -- 3.  For each dependent module, find its linkable
 573         --     This will either be in the HPT or (in the case of one-shot
 574         --     compilation) we may need to use maybe_getFileLinkable
 575         lnks_needed <- mapM (get_linkable maybe_normal_osuf) mods_needed ;
 576
 577         return (lnks_needed, pkgs_needed) }
 578   where
 579     dflags = hsc_dflags hsc_env
 580     this_pkg = thisPackage dflags
 581
 582         -- The ModIface contains the transitive closure of the module dependencies
 583         -- within the current package, *except* for boot modules: if we encounter
 584         -- a boot module, we have to find its real interface and discover the
 585         -- dependencies of that.  Hence we need to traverse the dependency
 586         -- tree recursively.  See bug #936, testcase ghci/prog007.
 587     follow_deps :: [Module]             -- modules to follow
 588                 -> UniqSet ModuleName         -- accum. module dependencies
 589                 -> UniqSet PackageId          -- accum. package dependencies
 590                 -> IO ([ModuleName], [PackageId]) -- result
 591     follow_deps []     acc_mods acc_pkgs
 592         = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
 593     follow_deps (mod:mods) acc_mods acc_pkgs
 594         = do
 595           mb_iface <- initIfaceCheck hsc_env $
 596                         loadInterface msg mod (ImportByUser False)
 597           iface <- case mb_iface of
 598                     Maybes.Failed err      -> ghcError (ProgramError (showSDoc err))
 599                     Maybes.Succeeded iface -> return iface
 600
 601           when (mi_boot iface) $ link_boot_mod_error mod
 602
 603           let
 604             pkg = modulePackageId mod
 605             deps  = mi_deps iface
 606
 607             pkg_deps = dep_pkgs deps
 608             (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps)
 609                     where is_boot (m,True)  = Left m
 610                           is_boot (m,False) = Right m
 611
 612             boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
 613             acc_mods'  = addListToUniqSet acc_mods (moduleName mod : mod_deps)
 614             acc_pkgs'  = addListToUniqSet acc_pkgs pkg_deps
 615           --
 616           if pkg /= this_pkg
 617              then follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg)
 618              else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods)
 619                               acc_mods' acc_pkgs'
 620         where
 621             msg = text "need to link module" <+> ppr mod <+>
 622                   text "due to use of Template Haskell"
 623
 624
 625     link_boot_mod_error mod =
 626         ghcError (ProgramError (showSDoc (
 627             text "module" <+> ppr mod <+>
 628             text "cannot be linked; it is only available as a boot module")))
 629
 630     no_obj mod = dieWith span $
 631                      ptext (sLit "cannot find object file for module ") <>
 632                         quotes (ppr mod) $$
 633                      while_linking_expr
 634
 635     while_linking_expr = ptext (sLit "while linking an interpreted expression")
 636
 637         -- This one is a build-system bug
 638
 639     get_linkable maybe_normal_osuf mod_name     -- A home-package module
 640         | Just mod_info <- lookupUFM hpt mod_name
 641         = ASSERT(isJust (hm_linkable mod_info))
 642           adjust_linkable (fromJust (hm_linkable mod_info))
 643         | otherwise
 644         = do    -- It's not in the HPT because we are in one shot mode,
 645                 -- so use the Finder to get a ModLocation...
 646              mb_stuff <- findHomeModule hsc_env mod_name
 647              case mb_stuff of
 648                   Found loc mod -> found loc mod
 649                   _ -> no_obj mod_name
 650         where
 651             found loc mod = do {
 652                 -- ...and then find the linkable for it
 653                mb_lnk <- findObjectLinkableMaybe mod loc ;
 654                case mb_lnk of {
 655                   Nothing -> no_obj mod ;
 656                   Just lnk -> adjust_linkable lnk
 657               }}
 658
 659             adjust_linkable lnk
 660                 | Just osuf <- maybe_normal_osuf = do
 661                         new_uls <- mapM (adjust_ul osuf) (linkableUnlinked lnk)
 662                         return lnk{ linkableUnlinked=new_uls }
 663                 | otherwise =
 664                         return lnk
 665
 666             adjust_ul osuf (DotO file) = do
 667                 let new_file = replaceExtension file osuf
 668                 ok <- doesFileExist new_file
 669                 if (not ok)
 670                    then dieWith span $
 671                           ptext (sLit "cannot find normal object file ")
 672                                 <> quotes (text new_file) $$ while_linking_expr
 673                    else return (DotO new_file)
 674             adjust_ul _ _ = panic "adjust_ul"
 675 \end{code}
 676
 677
 678 %************************************************************************
 679 %*                                                                      *
 680                 Link some linkables
 681         The linkables may consist of a mixture of
 682         byte-code modules and object modules
 683 %*                                                                      *
 684 %************************************************************************
 685
 686 \begin{code}
 687 linkModules :: DynFlags -> [Linkable] -> IO SuccessFlag
 688 linkModules dflags linkables
 689   = block $ do  -- don't want to be interrupted by ^C in here
 690
 691         let (objs, bcos) = partition isObjectLinkable
 692                               (concatMap partitionLinkable linkables)
 693
 694                 -- Load objects first; they can't depend on BCOs
 695         ok_flag <- dynLinkObjs dflags objs
 696
 697         if failed ok_flag then
 698                 return Failed
 699           else do
 700                 dynLinkBCOs bcos
 701                 return Succeeded
 702
 703
 704 -- HACK to support f-x-dynamic in the interpreter; no other purpose
 705 partitionLinkable :: Linkable -> [Linkable]
 706 partitionLinkable li
 707    = let li_uls = linkableUnlinked li
 708          li_uls_obj = filter isObject li_uls
 709          li_uls_bco = filter isInterpretable li_uls
 710      in
 711          case (li_uls_obj, li_uls_bco) of
 712             (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj},
 713                            li {linkableUnlinked=li_uls_bco}]
 714             _ -> [li]
 715
 716 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 717 findModuleLinkable_maybe lis mod
 718    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
 719         []   -> Nothing
 720         [li] -> Just li
 721         _    -> pprPanic "findModuleLinkable" (ppr mod)
 722
 723 linkableInSet :: Linkable -> [Linkable] -> Bool
 724 linkableInSet l objs_loaded =
 725   case findModuleLinkable_maybe objs_loaded (linkableModule l) of
 726         Nothing -> False
 727         Just m  -> linkableTime l == linkableTime m
 728 \end{code}
 729
 730
 731 %************************************************************************
 732 %*                                                                      *
 733 \subsection{The object-code linker}
 734 %*                                                                      *
 735 %************************************************************************
 736
 737 \begin{code}
 738 dynLinkObjs :: DynFlags -> [Linkable] -> IO SuccessFlag
 739         -- Side-effects the PersistentLinkerState
 740
 741 dynLinkObjs dflags objs
 742   = do  pls <- readIORef v_PersistentLinkerState
 743
 744         -- Load the object files and link them
 745         let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
 746             pls1                     = pls { objs_loaded = objs_loaded' }
 747             unlinkeds                = concatMap linkableUnlinked new_objs
 748
 749         mapM loadObj (map nameOfObject unlinkeds)
 750
 751         -- Link the all together
 752         ok <- resolveObjs
 753
 754         -- If resolving failed, unload all our
 755         -- object modules and carry on
 756         if succeeded ok then do
 757                 writeIORef v_PersistentLinkerState pls1
 758                 return Succeeded
 759           else do
 760                 pls2 <- unload_wkr dflags [] pls1
 761                 writeIORef v_PersistentLinkerState pls2
 762                 return Failed
 763
 764
 765 rmDupLinkables :: [Linkable]    -- Already loaded
 766                -> [Linkable]    -- New linkables
 767                -> ([Linkable],  -- New loaded set (including new ones)
 768                    [Linkable])  -- New linkables (excluding dups)
 769 rmDupLinkables already ls
 770   = go already [] ls
 771   where
 772     go already extras [] = (already, extras)
 773     go already extras (l:ls)
 774         | linkableInSet l already = go already     extras     ls
 775         | otherwise               = go (l:already) (l:extras) ls
 776 \end{code}
 777
 778 %************************************************************************
 779 %*                                                                      *
 780 \subsection{The byte-code linker}
 781 %*                                                                      *
 782 %************************************************************************
 783
 784 \begin{code}
 785 dynLinkBCOs :: [Linkable] -> IO ()
 786         -- Side-effects the persistent linker state
 787 dynLinkBCOs bcos
 788   = do  pls <- readIORef v_PersistentLinkerState
 789
 790         let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
 791             pls1                     = pls { bcos_loaded = bcos_loaded' }
 792             unlinkeds :: [Unlinked]
 793             unlinkeds                = concatMap linkableUnlinked new_bcos
 794
 795             cbcs :: [CompiledByteCode]
 796             cbcs      = map byteCodeOfObject unlinkeds
 797
 798
 799             ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
 800             ies        = [ie | ByteCode _ ie <- cbcs]
 801             gce       = closure_env pls
 802             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 803
 804         (final_gce, _linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
 805                 -- XXX What happens to these linked_bcos?
 806
 807         let pls2 = pls1 { closure_env = final_gce,
 808                           itbl_env    = final_ie }
 809
 810         writeIORef v_PersistentLinkerState pls2
 811         return ()
 812
 813 -- Link a bunch of BCOs and return them + updated closure env.
 814 linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
 815                         -- True  <=> add only toplevel BCOs to closure env
 816              -> ItblEnv
 817              -> ClosureEnv
 818              -> [UnlinkedBCO]
 819              -> IO (ClosureEnv, [HValue])
 820                         -- The returned HValues are associated 1-1 with
 821                         -- the incoming unlinked BCOs.  Each gives the
 822                         -- value of the corresponding unlinked BCO
 823
 824 linkSomeBCOs toplevs_only ie ce_in ul_bcos
 825    = do let nms = map unlinkedBCOName ul_bcos
 826         hvals <- fixIO
 827                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
 828                                in  mapM (linkBCO ie ce_out) ul_bcos )
 829         let ce_all_additions = zip nms hvals
 830             ce_top_additions = filter (isExternalName.fst) ce_all_additions
 831             ce_additions     = if toplevs_only then ce_top_additions
 832                                                else ce_all_additions
 833             ce_out = -- make sure we're not inserting duplicate names into the
 834                      -- closure environment, which leads to trouble.
 835                      ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
 836                      extendClosureEnv ce_in ce_additions
 837         return (ce_out, hvals)
 838
 839 \end{code}
 840
 841
 842 %************************************************************************
 843 %*                                                                      *
 844                 Unload some object modules
 845 %*                                                                      *
 846 %************************************************************************
 847
 848 \begin{code}
 849 -- ---------------------------------------------------------------------------
 850 -- Unloading old objects ready for a new compilation sweep.
 851 --
 852 -- The compilation manager provides us with a list of linkables that it
 853 -- considers "stable", i.e. won't be recompiled this time around.  For
 854 -- each of the modules current linked in memory,
 855 --
 856 --      * if the linkable is stable (and it's the same one - the
 857 --        user may have recompiled the module on the side), we keep it,
 858 --
 859 --      * otherwise, we unload it.
 860 --
 861 --      * we also implicitly unload all temporary bindings at this point.
 862
 863 unload :: DynFlags -> [Linkable] -> IO ()
 864 -- The 'linkables' are the ones to *keep*
 865
 866 unload dflags linkables
 867   = block $ do -- block, so we're safe from Ctrl-C in here
 868
 869         -- Initialise the linker (if it's not been done already)
 870         initDynLinker dflags
 871
 872         pls     <- readIORef v_PersistentLinkerState
 873         new_pls <- unload_wkr dflags linkables pls
 874         writeIORef v_PersistentLinkerState new_pls
 875
 876         debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
 877         debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
 878         return ()
 879
 880 unload_wkr :: DynFlags
 881            -> [Linkable]                -- stable linkables
 882            -> PersistentLinkerState
 883            -> IO PersistentLinkerState
 884 -- Does the core unload business
 885 -- (the wrapper blocks exceptions and deals with the PLS get and put)
 886
 887 unload_wkr _ linkables pls
 888   = do  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
 889
 890         objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
 891         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 892
 893         let bcos_retained = map linkableModule bcos_loaded'
 894             itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
 895             closure_env'  = filterNameMap bcos_retained (closure_env pls)
 896             new_pls = pls { itbl_env = itbl_env',
 897                             closure_env = closure_env',
 898                             bcos_loaded = bcos_loaded',
 899                             objs_loaded = objs_loaded' }
 900
 901         return new_pls
 902   where
 903     maybeUnload :: [Linkable] -> Linkable -> IO Bool
 904     maybeUnload keep_linkables lnk
 905       | linkableInSet lnk keep_linkables = return True
 906       | otherwise
 907       = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk]
 908                 -- The components of a BCO linkable may contain
 909                 -- dot-o files.  Which is very confusing.
 910                 --
 911                 -- But the BCO parts can be unlinked just by
 912                 -- letting go of them (plus of course depopulating
 913                 -- the symbol table which is done in the main body)
 914            return False
 915 \end{code}
 916
 917
 918 %************************************************************************
 919 %*                                                                      *
 920                 Loading packages
 921 %*                                                                      *
 922 %************************************************************************
 923
 924
 925 \begin{code}
 926 data LibrarySpec
 927    = Object FilePath    -- Full path name of a .o file, including trailing .o
 928                         -- For dynamic objects only, try to find the object
 929                         -- file in all the directories specified in
 930                         -- v_Library_paths before giving up.
 931
 932    | DLL String         -- "Unadorned" name of a .DLL/.so
 933                         --  e.g.    On unix     "qt"  denotes "libqt.so"
 934                         --          On WinDoze  "burble"  denotes "burble.DLL"
 935                         --  loadDLL is platform-specific and adds the lib/.so/.DLL
 936                         --  suffixes platform-dependently
 937
 938    | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
 939                         -- (ends with .dll or .so).
 940
 941    | Framework String   -- Only used for darwin, but does no harm
 942
 943 -- If this package is already part of the GHCi binary, we'll already
 944 -- have the right DLLs for this package loaded, so don't try to
 945 -- load them again.
 946 --
 947 -- But on Win32 we must load them 'again'; doing so is a harmless no-op
 948 -- as far as the loader is concerned, but it does initialise the list
 949 -- of DLL handles that rts/Linker.c maintains, and that in turn is
 950 -- used by lookupSymbol.  So we must call addDLL for each library
 951 -- just to get the DLL handle into the list.
 952 partOfGHCi :: [PackageName]
 953 partOfGHCi
 954  | isWindowsTarget || isDarwinTarget = []
 955  | otherwise = map PackageName
 956                    ["base", "haskell98", "template-haskell", "editline"]
 957
 958 showLS :: LibrarySpec -> String
 959 showLS (Object nm)    = "(static) " ++ nm
 960 showLS (DLL nm)       = "(dynamic) " ++ nm
 961 showLS (DLLPath nm)   = "(dynamic) " ++ nm
 962 showLS (Framework nm) = "(framework) " ++ nm
 963
 964 linkPackages :: DynFlags -> [PackageId] -> IO ()
 965 -- Link exactly the specified packages, and their dependents
 966 -- (unless of course they are already linked)
 967 -- The dependents are linked automatically, and it doesn't matter
 968 -- what order you specify the input packages.
 969 --
 970 -- NOTE: in fact, since each module tracks all the packages it depends on,
 971 --       we don't really need to use the package-config dependencies.
 972 -- However we do need the package-config stuff (to find aux libs etc),
 973 -- and following them lets us load libraries in the right order, which
 974 -- perhaps makes the error message a bit more localised if we get a link
 975 -- failure.  So the dependency walking code is still here.
 976
 977 linkPackages dflags new_pkgs
 978    = do { pls     <- readIORef v_PersistentLinkerState
 979         ; let pkg_map = pkgIdMap (pkgState dflags)
 980
 981         ; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
 982
 983         ; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
 984         }
 985    where
 986      link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
 987      link pkg_map pkgs new_pkgs
 988         = foldM (link_one pkg_map) pkgs new_pkgs
 989
 990      link_one pkg_map pkgs new_pkg
 991         | new_pkg `elem` pkgs   -- Already linked
 992         = return pkgs
 993
 994         | Just pkg_cfg <- lookupPackage pkg_map new_pkg
 995         = do {  -- Link dependents first
 996                pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
 997                 -- Now link the package itself
 998              ; linkPackage dflags pkg_cfg
 999              ; return (new_pkg : pkgs') }
1000
1001         | otherwise
1002         = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
1003
1004
1005 linkPackage :: DynFlags -> PackageConfig -> IO ()
1006 linkPackage dflags pkg
1007    = do
1008         let dirs      =  Packages.libraryDirs pkg
1009
1010         let libs      =  Packages.hsLibraries pkg
1011         -- Because of slight differences between the GHC dynamic linker and
1012         -- the native system linker some packages have to link with a
1013         -- different list of libraries when using GHCi. Examples include: libs
1014         -- that are actually gnu ld scripts, and the possability that the .a
1015         -- libs do not exactly match the .so/.dll equivalents. So if the
1016         -- package file provides an "extra-ghci-libraries" field then we use
1017         -- that instead of the "extra-libraries" field.
1018                       ++ (if null (Packages.extraGHCiLibraries pkg)
1019                             then Packages.extraLibraries pkg
1020                             else Packages.extraGHCiLibraries pkg)
1021                       ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
1022         classifieds   <- mapM (locateOneObj dirs) libs
1023
1024         -- Complication: all the .so's must be loaded before any of the .o's.
1025         let dlls = [ dll | DLL dll    <- classifieds ]
1026             objs = [ obj | Object obj <- classifieds ]
1027
1028         maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
1029
1030         -- See comments with partOfGHCi
1031         when (packageName pkg `notElem` partOfGHCi) $ do
1032             loadFrameworks pkg
1033             -- When a library A needs symbols from a library B, the order in
1034             -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
1035             -- way ld expects it for static linking. Dynamic linking is a
1036             -- different story: When A has no dependency information for B,
1037             -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
1038             -- when B has not been loaded before. In a nutshell: Reverse the
1039             -- order of DLLs for dynamic linking.
1040             -- This fixes a problem with the HOpenGL package (see "Compiling
1041             -- HOpenGL under recent versions of GHC" on the HOpenGL list).
1042             mapM_ (load_dyn dirs) (reverse dlls)
1043
1044         -- After loading all the DLLs, we can load the static objects.
1045         -- Ordering isn't important here, because we do one final link
1046         -- step to resolve everything.
1047         mapM_ loadObj objs
1048
1049         maybePutStr dflags "linking ... "
1050         ok <- resolveObjs
1051         if succeeded ok then maybePutStrLn dflags "done."
1052               else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
1053
1054 load_dyn :: [FilePath] -> FilePath -> IO ()
1055 load_dyn dirs dll = do r <- loadDynamic dirs dll
1056                        case r of
1057                          Nothing  -> return ()
1058                          Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
1059                                                               ++ dll ++ " (" ++ err ++ ")" ))
1060
1061 loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
1062 loadFrameworks pkg
1063  | isDarwinTarget = mapM_ load frameworks
1064  | otherwise = return ()
1065   where
1066     fw_dirs    = Packages.frameworkDirs pkg
1067     frameworks = Packages.frameworks pkg
1068
1069     load fw = do  r <- loadFramework fw_dirs fw
1070                   case r of
1071                     Nothing  -> return ()
1072                     Just err -> ghcError (CmdLineError ("can't load framework: "
1073                                                         ++ fw ++ " (" ++ err ++ ")" ))
1074
1075 -- Try to find an object file for a given library in the given paths.
1076 -- If it isn't present, we assume it's a dynamic library.
1077 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
1078 locateOneObj dirs lib
1079  | not picIsOn
1080     -- When the GHC package was not compiled as dynamic library
1081     -- (=__PIC__ not set), we search for .o libraries first.
1082   = do  { mb_obj_path <- findFile mk_obj_path dirs
1083         ; case mb_obj_path of
1084             Just obj_path -> return (Object obj_path)
1085             Nothing       ->
1086                 do { mb_lib_path <- findFile mk_dyn_lib_path dirs
1087                    ; case mb_lib_path of
1088                        Just _  -> return (DLL dyn_lib_name)
1089                        Nothing -> return (DLL lib) }} -- We assume
1090  | otherwise
1091     -- When the GHC package was compiled as dynamic library (=__PIC__ set),
1092     -- we search for .so libraries first.
1093   = do  { mb_lib_path <- findFile mk_dyn_lib_path dirs
1094         ; case mb_lib_path of
1095             Just _ -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
1096             Nothing       ->
1097                 do { mb_obj_path <- findFile mk_obj_path dirs
1098                    ; case mb_obj_path of
1099                        Just obj_path -> return (Object obj_path)
1100                        Nothing       -> return (DLL lib) }}             -- We assume
1101    where
1102      mk_obj_path dir = dir </> (lib <.> "o")
1103      dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
1104      mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
1105
1106 -- ----------------------------------------------------------------------------
1107 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
1108
1109 -- return Nothing == success, else Just error message from dlopen
1110 loadDynamic :: [FilePath] -> FilePath -> IO (Maybe String)
1111 loadDynamic paths rootname
1112   = do  { mb_dll <- findFile mk_dll_path paths
1113         ; case mb_dll of
1114             Just dll -> loadDLL dll
1115             Nothing  -> loadDLL (mkSOName rootname) }
1116                         -- Tried all our known library paths, so let
1117                         -- dlopen() search its own builtin paths now.
1118   where
1119     mk_dll_path dir = dir </> mkSOName rootname
1120
1121 mkSOName :: FilePath -> FilePath
1122 mkSOName root
1123  | isDarwinTarget  = ("lib" ++ root) <.> "dylib"
1124  | isWindowsTarget = -- Win32 DLLs have no .dll extension here, because
1125                      -- addDLL tries both foo.dll and foo.drv
1126                      root
1127  | otherwise       = ("lib" ++ root) <.> "so"
1128
1129 -- Darwin / MacOS X only: load a framework
1130 -- a framework is a dynamic library packaged inside a directory of the same
1131 -- name. They are searched for in different paths than normal libraries.
1132 loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
1133 loadFramework extraPaths rootname
1134    = do { either_dir <- tryIO getHomeDirectory
1135         ; let homeFrameworkPath = case either_dir of
1136                                   Left _ -> []
1137                                   Right dir -> [dir ++ "/Library/Frameworks"]
1138               ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths
1139         ; mb_fwk <- findFile mk_fwk ps
1140         ; case mb_fwk of
1141             Just fwk_path -> loadDLL fwk_path
1142             Nothing       -> return (Just "not found") }
1143                 -- Tried all our known library paths, but dlopen()
1144                 -- has no built-in paths for frameworks: give up
1145    where
1146      mk_fwk dir = dir </> (rootname ++ ".framework/" ++ rootname)
1147         -- sorry for the hardcoded paths, I hope they won't change anytime soon:
1148      defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
1149 \end{code}
1150
1151 %************************************************************************
1152 %*                                                                      *
1153                 Helper functions
1154 %*                                                                      *
1155 %************************************************************************
1156
1157 \begin{code}
1158 findFile :: (FilePath -> FilePath)      -- Maps a directory path to a file path
1159          -> [FilePath]                  -- Directories to look in
1160          -> IO (Maybe FilePath)         -- The first file path to match
1161 findFile _ []
1162   = return Nothing
1163 findFile mk_file_path (dir:dirs)
1164   = do  { let file_path = mk_file_path dir
1165         ; b <- doesFileExist file_path
1166         ; if b then
1167              return (Just file_path)
1168           else
1169              findFile mk_file_path dirs }
1170 \end{code}
1171
1172 \begin{code}
1173 maybePutStr :: DynFlags -> String -> IO ()
1174 maybePutStr dflags s | verbosity dflags > 0 = putStr s
1175                      | otherwise            = return ()
1176
1177 maybePutStrLn :: DynFlags -> String -> IO ()
1178 maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
1179                        | otherwise            = return ()
1180 \end{code}