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, PackageId)
  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 "failed.\n"
 460             ghcError $
 461               CmdLineError (
 462                     "user specified .o/.so/.DLL could not be loaded ("
 463                     ++ sys_errmsg ++ ")\nWhilst trying to load:  "
 464                     ++ showLS spec ++ "\nAdditional directories searched:"
 465                     ++ (if null paths then " (none)" else
 466                         (concat (intersperse "\n" (map ("   "++) paths)))))
 467
 468     -- Not interested in the paths in the static case.
 469     preload_static _paths name
 470        = do b <- doesFileExist name
 471             if not b then return False
 472                      else loadObj name >> return True
 473 \end{code}
 474
 475
 476 %************************************************************************
 477 %*                                                                      *
 478                 Link a byte-code expression
 479 %*                                                                      *
 480 %************************************************************************
 481
 482 \begin{code}
 483 linkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO HValue
 484
 485 -- Link a single expression, *including* first linking packages and
 486 -- modules that this expression depends on.
 487 --
 488 -- Raises an IO exception if it can't find a compiled version of the
 489 -- dependents to link.
 490 --
 491 -- Note: This function side-effects the linker state (Pepe)
 492
 493 linkExpr hsc_env span root_ul_bco
 494   = do {
 495         -- Initialise the linker (if it's not been done already)
 496      let dflags = hsc_dflags hsc_env
 497    ; initDynLinker dflags
 498
 499         -- Link the packages and modules required
 500    ; ok <- linkDependencies hsc_env span needed_mods
 501    ; if failed ok then
 502         ghcError (ProgramError "")
 503      else do {
 504
 505         -- Link the expression itself
 506      pls <- readIORef v_PersistentLinkerState
 507    ; let ie = itbl_env pls
 508          ce = closure_env pls
 509
 510         -- Link the necessary packages and linkables
 511    ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
 512    ; return root_hval
 513    }}
 514    where
 515      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 516
 517      needed_mods :: [Module]
 518      needed_mods = [ nameModule n | n <- free_names,
 519                                     isExternalName n,           -- Names from other modules
 520                                     not (isWiredInName n)       -- Exclude wired-in names
 521                    ]                                            -- (see note below)
 522         -- Exclude wired-in names because we may not have read
 523         -- their interface files, so getLinkDeps will fail
 524         -- All wired-in names are in the base package, which we link
 525         -- by default, so we can safely ignore them here.
 526
 527 dieWith :: SrcSpan -> Message -> IO a
 528 dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
 529
 530
 531 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
 532 checkNonStdWay dflags srcspan = do
 533   tag <- readIORef v_Build_tag
 534   if null tag then return Nothing else do
 535   let default_osuf = phaseInputExt StopLn
 536   if objectSuf dflags == default_osuf
 537         then failNonStd srcspan
 538         else return (Just default_osuf)
 539
 540 failNonStd :: SrcSpan -> IO (Maybe String)
 541 failNonStd srcspan = dieWith srcspan $
 542   ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$
 543   ptext (sLit "You need to build the program twice: once the normal way, and then") $$
 544   ptext (sLit "in the desired way using -osuf to set the object file suffix.")
 545
 546
 547 getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable
 548             -> Maybe String                     -- the "normal" object suffix
 549             -> SrcSpan                          -- for error messages
 550             -> [Module]                         -- If you need these
 551             -> IO ([Linkable], [PackageId])     -- ... then link these first
 552 -- Fails with an IO exception if it can't find enough files
 553
 554 getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
 555 -- Find all the packages and linkables that a set of modules depends on
 556  = do { pls <- readIORef v_PersistentLinkerState ;
 557         -- 1.  Find the dependent home-pkg-modules/packages from each iface
 558         (mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet;
 559
 560         let {
 561         -- 2.  Exclude ones already linked
 562         --      Main reason: avoid findModule calls in get_linkable
 563             mods_needed = mods_s `minusList` linked_mods     ;
 564             pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 565
 566             linked_mods = map (moduleName.linkableModule)
 567                                 (objs_loaded pls ++ bcos_loaded pls)
 568         } ;
 569
 570 --        putStrLn (showSDoc (ppr mods_s)) ;
 571         -- 3.  For each dependent module, find its linkable
 572         --     This will either be in the HPT or (in the case of one-shot
 573         --     compilation) we may need to use maybe_getFileLinkable
 574         lnks_needed <- mapM (get_linkable maybe_normal_osuf) mods_needed ;
 575
 576         return (lnks_needed, pkgs_needed) }
 577   where
 578     dflags = hsc_dflags hsc_env
 579     this_pkg = thisPackage dflags
 580
 581         -- The ModIface contains the transitive closure of the module dependencies
 582         -- within the current package, *except* for boot modules: if we encounter
 583         -- a boot module, we have to find its real interface and discover the
 584         -- dependencies of that.  Hence we need to traverse the dependency
 585         -- tree recursively.  See bug #936, testcase ghci/prog007.
 586     follow_deps :: [Module]             -- modules to follow
 587                 -> UniqSet ModuleName         -- accum. module dependencies
 588                 -> UniqSet PackageId          -- accum. package dependencies
 589                 -> IO ([ModuleName], [PackageId]) -- result
 590     follow_deps []     acc_mods acc_pkgs
 591         = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
 592     follow_deps (mod:mods) acc_mods acc_pkgs
 593         = do
 594           mb_iface <- initIfaceCheck hsc_env $
 595                         loadInterface msg mod (ImportByUser False)
 596           iface <- case mb_iface of
 597                     Maybes.Failed err      -> ghcError (ProgramError (showSDoc err))
 598                     Maybes.Succeeded iface -> return iface
 599
 600           when (mi_boot iface) $ link_boot_mod_error mod
 601
 602           let
 603             pkg = modulePackageId mod
 604             deps  = mi_deps iface
 605
 606             pkg_deps = dep_pkgs deps
 607             (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps)
 608                     where is_boot (m,True)  = Left m
 609                           is_boot (m,False) = Right m
 610
 611             boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
 612             acc_mods'  = addListToUniqSet acc_mods (moduleName mod : mod_deps)
 613             acc_pkgs'  = addListToUniqSet acc_pkgs pkg_deps
 614           --
 615           if pkg /= this_pkg
 616              then follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg)
 617              else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods)
 618                               acc_mods' acc_pkgs'
 619         where
 620             msg = text "need to link module" <+> ppr mod <+>
 621                   text "due to use of Template Haskell"
 622
 623
 624     link_boot_mod_error mod =
 625         ghcError (ProgramError (showSDoc (
 626             text "module" <+> ppr mod <+>
 627             text "cannot be linked; it is only available as a boot module")))
 628
 629     no_obj mod = dieWith span $
 630                      ptext (sLit "cannot find object file for module ") <>
 631                         quotes (ppr mod) $$
 632                      while_linking_expr
 633
 634     while_linking_expr = ptext (sLit "while linking an interpreted expression")
 635
 636         -- This one is a build-system bug
 637
 638     get_linkable maybe_normal_osuf mod_name     -- A home-package module
 639         | Just mod_info <- lookupUFM hpt mod_name
 640         = ASSERT(isJust (hm_linkable mod_info))
 641           adjust_linkable (fromJust (hm_linkable mod_info))
 642         | otherwise
 643         = do    -- It's not in the HPT because we are in one shot mode,
 644                 -- so use the Finder to get a ModLocation...
 645              mb_stuff <- findHomeModule hsc_env mod_name
 646              case mb_stuff of
 647                   Found loc mod -> found loc mod
 648                   _ -> no_obj mod_name
 649         where
 650             found loc mod = do {
 651                 -- ...and then find the linkable for it
 652                mb_lnk <- findObjectLinkableMaybe mod loc ;
 653                case mb_lnk of {
 654                   Nothing -> no_obj mod ;
 655                   Just lnk -> adjust_linkable lnk
 656               }}
 657
 658             adjust_linkable lnk
 659                 | Just osuf <- maybe_normal_osuf = do
 660                         new_uls <- mapM (adjust_ul osuf) (linkableUnlinked lnk)
 661                         return lnk{ linkableUnlinked=new_uls }
 662                 | otherwise =
 663                         return lnk
 664
 665             adjust_ul osuf (DotO file) = do
 666                 let new_file = replaceExtension file osuf
 667                 ok <- doesFileExist new_file
 668                 if (not ok)
 669                    then dieWith span $
 670                           ptext (sLit "cannot find normal object file ")
 671                                 <> quotes (text new_file) $$ while_linking_expr
 672                    else return (DotO new_file)
 673             adjust_ul _ _ = panic "adjust_ul"
 674 \end{code}
 675
 676
 677 %************************************************************************
 678 %*                                                                      *
 679                 Link some linkables
 680         The linkables may consist of a mixture of
 681         byte-code modules and object modules
 682 %*                                                                      *
 683 %************************************************************************
 684
 685 \begin{code}
 686 linkModules :: DynFlags -> [Linkable] -> IO SuccessFlag
 687 linkModules dflags linkables
 688   = block $ do  -- don't want to be interrupted by ^C in here
 689
 690         let (objs, bcos) = partition isObjectLinkable
 691                               (concatMap partitionLinkable linkables)
 692
 693                 -- Load objects first; they can't depend on BCOs
 694         ok_flag <- dynLinkObjs dflags objs
 695
 696         if failed ok_flag then
 697                 return Failed
 698           else do
 699                 dynLinkBCOs bcos
 700                 return Succeeded
 701
 702
 703 -- HACK to support f-x-dynamic in the interpreter; no other purpose
 704 partitionLinkable :: Linkable -> [Linkable]
 705 partitionLinkable li
 706    = let li_uls = linkableUnlinked li
 707          li_uls_obj = filter isObject li_uls
 708          li_uls_bco = filter isInterpretable li_uls
 709      in
 710          case (li_uls_obj, li_uls_bco) of
 711             (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj},
 712                            li {linkableUnlinked=li_uls_bco}]
 713             _ -> [li]
 714
 715 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 716 findModuleLinkable_maybe lis mod
 717    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
 718         []   -> Nothing
 719         [li] -> Just li
 720         _    -> pprPanic "findModuleLinkable" (ppr mod)
 721
 722 linkableInSet :: Linkable -> [Linkable] -> Bool
 723 linkableInSet l objs_loaded =
 724   case findModuleLinkable_maybe objs_loaded (linkableModule l) of
 725         Nothing -> False
 726         Just m  -> linkableTime l == linkableTime m
 727 \end{code}
 728
 729
 730 %************************************************************************
 731 %*                                                                      *
 732 \subsection{The object-code linker}
 733 %*                                                                      *
 734 %************************************************************************
 735
 736 \begin{code}
 737 dynLinkObjs :: DynFlags -> [Linkable] -> IO SuccessFlag
 738         -- Side-effects the PersistentLinkerState
 739
 740 dynLinkObjs dflags objs
 741   = do  pls <- readIORef v_PersistentLinkerState
 742
 743         -- Load the object files and link them
 744         let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
 745             pls1                     = pls { objs_loaded = objs_loaded' }
 746             unlinkeds                = concatMap linkableUnlinked new_objs
 747
 748         mapM loadObj (map nameOfObject unlinkeds)
 749
 750         -- Link the all together
 751         ok <- resolveObjs
 752
 753         -- If resolving failed, unload all our
 754         -- object modules and carry on
 755         if succeeded ok then do
 756                 writeIORef v_PersistentLinkerState pls1
 757                 return Succeeded
 758           else do
 759                 pls2 <- unload_wkr dflags [] pls1
 760                 writeIORef v_PersistentLinkerState pls2
 761                 return Failed
 762
 763
 764 rmDupLinkables :: [Linkable]    -- Already loaded
 765                -> [Linkable]    -- New linkables
 766                -> ([Linkable],  -- New loaded set (including new ones)
 767                    [Linkable])  -- New linkables (excluding dups)
 768 rmDupLinkables already ls
 769   = go already [] ls
 770   where
 771     go already extras [] = (already, extras)
 772     go already extras (l:ls)
 773         | linkableInSet l already = go already     extras     ls
 774         | otherwise               = go (l:already) (l:extras) ls
 775 \end{code}
 776
 777 %************************************************************************
 778 %*                                                                      *
 779 \subsection{The byte-code linker}
 780 %*                                                                      *
 781 %************************************************************************
 782
 783 \begin{code}
 784 dynLinkBCOs :: [Linkable] -> IO ()
 785         -- Side-effects the persistent linker state
 786 dynLinkBCOs bcos
 787   = do  pls <- readIORef v_PersistentLinkerState
 788
 789         let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
 790             pls1                     = pls { bcos_loaded = bcos_loaded' }
 791             unlinkeds :: [Unlinked]
 792             unlinkeds                = concatMap linkableUnlinked new_bcos
 793
 794             cbcs :: [CompiledByteCode]
 795             cbcs      = map byteCodeOfObject unlinkeds
 796
 797
 798             ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
 799             ies        = [ie | ByteCode _ ie <- cbcs]
 800             gce       = closure_env pls
 801             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 802
 803         (final_gce, _linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
 804                 -- XXX What happens to these linked_bcos?
 805
 806         let pls2 = pls1 { closure_env = final_gce,
 807                           itbl_env    = final_ie }
 808
 809         writeIORef v_PersistentLinkerState pls2
 810         return ()
 811
 812 -- Link a bunch of BCOs and return them + updated closure env.
 813 linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
 814                         -- True  <=> add only toplevel BCOs to closure env
 815              -> ItblEnv
 816              -> ClosureEnv
 817              -> [UnlinkedBCO]
 818              -> IO (ClosureEnv, [HValue])
 819                         -- The returned HValues are associated 1-1 with
 820                         -- the incoming unlinked BCOs.  Each gives the
 821                         -- value of the corresponding unlinked BCO
 822
 823 linkSomeBCOs toplevs_only ie ce_in ul_bcos
 824    = do let nms = map unlinkedBCOName ul_bcos
 825         hvals <- fixIO
 826                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
 827                                in  mapM (linkBCO ie ce_out) ul_bcos )
 828         let ce_all_additions = zip nms hvals
 829             ce_top_additions = filter (isExternalName.fst) ce_all_additions
 830             ce_additions     = if toplevs_only then ce_top_additions
 831                                                else ce_all_additions
 832             ce_out = -- make sure we're not inserting duplicate names into the
 833                      -- closure environment, which leads to trouble.
 834                      ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
 835                      extendClosureEnv ce_in ce_additions
 836         return (ce_out, hvals)
 837
 838 \end{code}
 839
 840
 841 %************************************************************************
 842 %*                                                                      *
 843                 Unload some object modules
 844 %*                                                                      *
 845 %************************************************************************
 846
 847 \begin{code}
 848 -- ---------------------------------------------------------------------------
 849 -- Unloading old objects ready for a new compilation sweep.
 850 --
 851 -- The compilation manager provides us with a list of linkables that it
 852 -- considers "stable", i.e. won't be recompiled this time around.  For
 853 -- each of the modules current linked in memory,
 854 --
 855 --      * if the linkable is stable (and it's the same one - the
 856 --        user may have recompiled the module on the side), we keep it,
 857 --
 858 --      * otherwise, we unload it.
 859 --
 860 --      * we also implicitly unload all temporary bindings at this point.
 861
 862 unload :: DynFlags -> [Linkable] -> IO ()
 863 -- The 'linkables' are the ones to *keep*
 864
 865 unload dflags linkables
 866   = block $ do -- block, so we're safe from Ctrl-C in here
 867
 868         -- Initialise the linker (if it's not been done already)
 869         initDynLinker dflags
 870
 871         pls     <- readIORef v_PersistentLinkerState
 872         new_pls <- unload_wkr dflags linkables pls
 873         writeIORef v_PersistentLinkerState new_pls
 874
 875         debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
 876         debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
 877         return ()
 878
 879 unload_wkr :: DynFlags
 880            -> [Linkable]                -- stable linkables
 881            -> PersistentLinkerState
 882            -> IO PersistentLinkerState
 883 -- Does the core unload business
 884 -- (the wrapper blocks exceptions and deals with the PLS get and put)
 885
 886 unload_wkr _ linkables pls
 887   = do  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
 888
 889         objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
 890         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 891
 892         let bcos_retained = map linkableModule bcos_loaded'
 893             itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
 894             closure_env'  = filterNameMap bcos_retained (closure_env pls)
 895             new_pls = pls { itbl_env = itbl_env',
 896                             closure_env = closure_env',
 897                             bcos_loaded = bcos_loaded',
 898                             objs_loaded = objs_loaded' }
 899
 900         return new_pls
 901   where
 902     maybeUnload :: [Linkable] -> Linkable -> IO Bool
 903     maybeUnload keep_linkables lnk
 904       | linkableInSet lnk keep_linkables = return True
 905       | otherwise
 906       = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk]
 907                 -- The components of a BCO linkable may contain
 908                 -- dot-o files.  Which is very confusing.
 909                 --
 910                 -- But the BCO parts can be unlinked just by
 911                 -- letting go of them (plus of course depopulating
 912                 -- the symbol table which is done in the main body)
 913            return False
 914 \end{code}
 915
 916
 917 %************************************************************************
 918 %*                                                                      *
 919                 Loading packages
 920 %*                                                                      *
 921 %************************************************************************
 922
 923
 924 \begin{code}
 925 data LibrarySpec
 926    = Object FilePath    -- Full path name of a .o file, including trailing .o
 927                         -- For dynamic objects only, try to find the object
 928                         -- file in all the directories specified in
 929                         -- v_Library_paths before giving up.
 930
 931    | DLL String         -- "Unadorned" name of a .DLL/.so
 932                         --  e.g.    On unix     "qt"  denotes "libqt.so"
 933                         --          On WinDoze  "burble"  denotes "burble.DLL"
 934                         --  loadDLL is platform-specific and adds the lib/.so/.DLL
 935                         --  suffixes platform-dependently
 936
 937    | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
 938                         -- (ends with .dll or .so).
 939
 940    | Framework String   -- Only used for darwin, but does no harm
 941
 942 -- If this package is already part of the GHCi binary, we'll already
 943 -- have the right DLLs for this package loaded, so don't try to
 944 -- load them again.
 945 --
 946 -- But on Win32 we must load them 'again'; doing so is a harmless no-op
 947 -- as far as the loader is concerned, but it does initialise the list
 948 -- of DLL handles that rts/Linker.c maintains, and that in turn is
 949 -- used by lookupSymbol.  So we must call addDLL for each library
 950 -- just to get the DLL handle into the list.
 951 partOfGHCi :: [PackageName]
 952 partOfGHCi
 953  | isWindowsTarget || isDarwinTarget = []
 954  | otherwise = map PackageName
 955                    ["base", "haskell98", "template-haskell", "editline"]
 956
 957 showLS :: LibrarySpec -> String
 958 showLS (Object nm)    = "(static) " ++ nm
 959 showLS (DLL nm)       = "(dynamic) " ++ nm
 960 showLS (DLLPath nm)   = "(dynamic) " ++ nm
 961 showLS (Framework nm) = "(framework) " ++ nm
 962
 963 linkPackages :: DynFlags -> [PackageId] -> IO ()
 964 -- Link exactly the specified packages, and their dependents
 965 -- (unless of course they are already linked)
 966 -- The dependents are linked automatically, and it doesn't matter
 967 -- what order you specify the input packages.
 968 --
 969 -- NOTE: in fact, since each module tracks all the packages it depends on,
 970 --       we don't really need to use the package-config dependencies.
 971 -- However we do need the package-config stuff (to find aux libs etc),
 972 -- and following them lets us load libraries in the right order, which
 973 -- perhaps makes the error message a bit more localised if we get a link
 974 -- failure.  So the dependency walking code is still here.
 975
 976 linkPackages dflags new_pkgs
 977    = do { pls     <- readIORef v_PersistentLinkerState
 978         ; let pkg_map = pkgIdMap (pkgState dflags)
 979
 980         ; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
 981
 982         ; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
 983         }
 984    where
 985      link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
 986      link pkg_map pkgs new_pkgs
 987         = foldM (link_one pkg_map) pkgs new_pkgs
 988
 989      link_one pkg_map pkgs new_pkg
 990         | new_pkg `elem` pkgs   -- Already linked
 991         = return pkgs
 992
 993         | Just pkg_cfg <- lookupPackage pkg_map new_pkg
 994         = do {  -- Link dependents first
 995                pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
 996                 -- Now link the package itself
 997              ; linkPackage dflags pkg_cfg
 998              ; return (new_pkg : pkgs') }
 999
1000         | otherwise
1001         = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
1002
1003
1004 linkPackage :: DynFlags -> PackageConfig -> IO ()
1005 linkPackage dflags pkg
1006    = do
1007         let dirs      =  Packages.libraryDirs pkg
1008
1009         let libs      =  Packages.hsLibraries pkg
1010         -- Because of slight differences between the GHC dynamic linker and
1011         -- the native system linker some packages have to link with a
1012         -- different list of libraries when using GHCi. Examples include: libs
1013         -- that are actually gnu ld scripts, and the possability that the .a
1014         -- libs do not exactly match the .so/.dll equivalents. So if the
1015         -- package file provides an "extra-ghci-libraries" field then we use
1016         -- that instead of the "extra-libraries" field.
1017                       ++ (if null (Packages.extraGHCiLibraries pkg)
1018                             then Packages.extraLibraries pkg
1019                             else Packages.extraGHCiLibraries pkg)
1020                       ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
1021         classifieds   <- mapM (locateOneObj dirs) libs
1022
1023         -- Complication: all the .so's must be loaded before any of the .o's.
1024         let dlls = [ dll | DLL dll    <- classifieds ]
1025             objs = [ obj | Object obj <- classifieds ]
1026
1027         maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
1028
1029         -- See comments with partOfGHCi
1030         when (packageName pkg `notElem` partOfGHCi) $ do
1031             loadFrameworks pkg
1032             -- When a library A needs symbols from a library B, the order in
1033             -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
1034             -- way ld expects it for static linking. Dynamic linking is a
1035             -- different story: When A has no dependency information for B,
1036             -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
1037             -- when B has not been loaded before. In a nutshell: Reverse the
1038             -- order of DLLs for dynamic linking.
1039             -- This fixes a problem with the HOpenGL package (see "Compiling
1040             -- HOpenGL under recent versions of GHC" on the HOpenGL list).
1041             mapM_ (load_dyn dirs) (reverse dlls)
1042
1043         -- After loading all the DLLs, we can load the static objects.
1044         -- Ordering isn't important here, because we do one final link
1045         -- step to resolve everything.
1046         mapM_ loadObj objs
1047
1048         maybePutStr dflags "linking ... "
1049         ok <- resolveObjs
1050         if succeeded ok then maybePutStrLn dflags "done."
1051               else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
1052
1053 load_dyn :: [FilePath] -> FilePath -> IO ()
1054 load_dyn dirs dll = do r <- loadDynamic dirs dll
1055                        case r of
1056                          Nothing  -> return ()
1057                          Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
1058                                                               ++ dll ++ " (" ++ err ++ ")" ))
1059
1060 loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
1061 loadFrameworks pkg
1062  | isDarwinTarget = mapM_ load frameworks
1063  | otherwise = return ()
1064   where
1065     fw_dirs    = Packages.frameworkDirs pkg
1066     frameworks = Packages.frameworks pkg
1067
1068     load fw = do  r <- loadFramework fw_dirs fw
1069                   case r of
1070                     Nothing  -> return ()
1071                     Just err -> ghcError (CmdLineError ("can't load framework: "
1072                                                         ++ fw ++ " (" ++ err ++ ")" ))
1073
1074 -- Try to find an object file for a given library in the given paths.
1075 -- If it isn't present, we assume it's a dynamic library.
1076 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
1077 locateOneObj dirs lib
1078  | not picIsOn
1079     -- When the GHC package was not compiled as dynamic library
1080     -- (=__PIC__ not set), we search for .o libraries first.
1081   = do  { mb_obj_path <- findFile mk_obj_path dirs
1082         ; case mb_obj_path of
1083             Just obj_path -> return (Object obj_path)
1084             Nothing       ->
1085                 do { mb_lib_path <- findFile mk_dyn_lib_path dirs
1086                    ; case mb_lib_path of
1087                        Just _  -> return (DLL dyn_lib_name)
1088                        Nothing -> return (DLL lib) }} -- We assume
1089  | otherwise
1090     -- When the GHC package was compiled as dynamic library (=__PIC__ set),
1091     -- we search for .so libraries first.
1092   = do  { mb_lib_path <- findFile mk_dyn_lib_path dirs
1093         ; case mb_lib_path of
1094             Just _ -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
1095             Nothing       ->
1096                 do { mb_obj_path <- findFile mk_obj_path dirs
1097                    ; case mb_obj_path of
1098                        Just obj_path -> return (Object obj_path)
1099                        Nothing       -> return (DLL lib) }}             -- We assume
1100    where
1101      mk_obj_path dir = dir </> (lib <.> "o")
1102      dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
1103      mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
1104
1105 -- ----------------------------------------------------------------------------
1106 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
1107
1108 -- return Nothing == success, else Just error message from dlopen
1109 loadDynamic :: [FilePath] -> FilePath -> IO (Maybe String)
1110 loadDynamic paths rootname
1111   = do  { mb_dll <- findFile mk_dll_path paths
1112         ; case mb_dll of
1113             Just dll -> loadDLL dll
1114             Nothing  -> loadDLL (mkSOName rootname) }
1115                         -- Tried all our known library paths, so let
1116                         -- dlopen() search its own builtin paths now.
1117   where
1118     mk_dll_path dir = dir </> mkSOName rootname
1119
1120 mkSOName :: FilePath -> FilePath
1121 mkSOName root
1122  | isDarwinTarget  = ("lib" ++ root) <.> "dylib"
1123  | isWindowsTarget = -- Win32 DLLs have no .dll extension here, because
1124                      -- addDLL tries both foo.dll and foo.drv
1125                      root
1126  | otherwise       = ("lib" ++ root) <.> "so"
1127
1128 -- Darwin / MacOS X only: load a framework
1129 -- a framework is a dynamic library packaged inside a directory of the same
1130 -- name. They are searched for in different paths than normal libraries.
1131 loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
1132 loadFramework extraPaths rootname
1133    = do { either_dir <- tryIO getHomeDirectory
1134         ; let homeFrameworkPath = case either_dir of
1135                                   Left _ -> []
1136                                   Right dir -> [dir ++ "/Library/Frameworks"]
1137               ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths
1138         ; mb_fwk <- findFile mk_fwk ps
1139         ; case mb_fwk of
1140             Just fwk_path -> loadDLL fwk_path
1141             Nothing       -> return (Just "not found") }
1142                 -- Tried all our known library paths, but dlopen()
1143                 -- has no built-in paths for frameworks: give up
1144    where
1145      mk_fwk dir = dir </> (rootname ++ ".framework/" ++ rootname)
1146         -- sorry for the hardcoded paths, I hope they won't change anytime soon:
1147      defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
1148 \end{code}
1149
1150 %************************************************************************
1151 %*                                                                      *
1152                 Helper functions
1153 %*                                                                      *
1154 %************************************************************************
1155
1156 \begin{code}
1157 findFile :: (FilePath -> FilePath)      -- Maps a directory path to a file path
1158          -> [FilePath]                  -- Directories to look in
1159          -> IO (Maybe FilePath)         -- The first file path to match
1160 findFile _ []
1161   = return Nothing
1162 findFile mk_file_path (dir:dirs)
1163   = do  { let file_path = mk_file_path dir
1164         ; b <- doesFileExist file_path
1165         ; if b then
1166              return (Just file_path)
1167           else
1168              findFile mk_file_path dirs }
1169 \end{code}
1170
1171 \begin{code}
1172 maybePutStr :: DynFlags -> String -> IO ()
1173 maybePutStr dflags s | verbosity dflags > 0 = putStr s
1174                      | otherwise            = return ()
1175
1176 maybePutStrLn :: DynFlags -> String -> IO ()
1177 maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
1178                        | otherwise            = return ()
1179 \end{code}