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