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 -w #-}
  18 -- The above warning supression flag is a temporary kludge.
  19 -- While working on this module you are encouraged to remove it and fix
  20 -- any warnings in the module. See
  21 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  22 -- for details
  23
  24 module Linker ( HValue, getHValue, showLinkerState,
  25                 linkExpr, unload, withExtendedLinkEnv,
  26                 extendLinkEnv, deleteFromLinkEnv,
  27                 extendLoadedPkgs,
  28                 linkPackages,initDynLinker,
  29                 dataConInfoPtrToName
  30         ) where
  31
  32 #include "HsVersions.h"
  33
  34 import ObjLink
  35 import ByteCodeLink
  36 import ByteCodeItbls
  37 import ByteCodeAsm
  38 import CgInfoTbls
  39 import SMRep
  40 import IfaceEnv
  41 import TcRnMonad
  42 import Packages
  43 import DriverPhases
  44 import Finder
  45 import HscTypes
  46 import Name
  47 import NameEnv
  48 import NameSet
  49 import qualified OccName
  50 import UniqFM
  51 import Module
  52 import ListSetOps
  53 import DynFlags
  54 import BasicTypes
  55 import Outputable
  56 import PackageConfig
  57 import Panic
  58 import Util
  59 import StaticFlags
  60 import ErrUtils
  61 import DriverPhases
  62 import SrcLoc
  63 import UniqSet
  64 import Constants
  65 import FastString
  66 import Config           ( cProjectVersion )
  67
  68 -- Standard libraries
  69 import Control.Monad
  70
  71 import Data.Char
  72 import Data.IORef
  73 import Data.List
  74 import Foreign
  75
  76 import System.IO
  77 import System.Directory
  78
  79 import Control.Exception
  80 import Data.Maybe
  81 \end{code}
  82
  83
  84 %************************************************************************
  85 %*                                                                      *
  86                         The Linker's state
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 The persistent linker state *must* match the actual state of the
  91 C dynamic linker at all times, so we keep it in a private global variable.
  92
  93
  94 The PersistentLinkerState maps Names to actual closures (for
  95 interpreted code only), for use during linking.
  96
  97 \begin{code}
  98 GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
  99 GLOBAL_VAR(v_InitLinkerDone, False, Bool)       -- Set True when dynamic linker is initialised
 100
 101 data PersistentLinkerState
 102    = PersistentLinkerState {
 103
 104         -- Current global mapping from Names to their true values
 105         closure_env :: ClosureEnv,
 106
 107         -- The current global mapping from RdrNames of DataCons to
 108         -- info table addresses.
 109         -- When a new Unlinked is linked into the running image, or an existing
 110         -- module in the image is replaced, the itbl_env must be updated
 111         -- appropriately.
 112         itbl_env    :: ItblEnv,
 113
 114         -- The currently loaded interpreted modules (home package)
 115         bcos_loaded :: [Linkable],
 116
 117         -- And the currently-loaded compiled modules (home package)
 118         objs_loaded :: [Linkable],
 119
 120         -- The currently-loaded packages; always object code
 121         -- Held, as usual, in dependency order; though I am not sure if
 122         -- that is really important
 123         pkgs_loaded :: [PackageId]
 124      }
 125
 126 emptyPLS :: DynFlags -> PersistentLinkerState
 127 emptyPLS dflags = PersistentLinkerState {
 128                         closure_env = emptyNameEnv,
 129                         itbl_env    = emptyNameEnv,
 130                         pkgs_loaded = init_pkgs,
 131                         bcos_loaded = [],
 132                         objs_loaded = [] }
 133
 134   -- Packages that don't need loading, because the compiler
 135   -- shares them with the interpreted program.
 136   --
 137   -- The linker's symbol table is populated with RTS symbols using an
 138   -- explicit list.  See rts/Linker.c for details.
 139   where init_pkgs = [rtsPackageId]
 140 \end{code}
 141
 142 \begin{code}
 143 extendLoadedPkgs :: [PackageId] -> IO ()
 144 extendLoadedPkgs pkgs
 145     = modifyIORef v_PersistentLinkerState (\s -> s{pkgs_loaded = pkgs ++ pkgs_loaded s})
 146
 147 extendLinkEnv :: [(Name,HValue)] -> IO ()
 148 -- Automatically discards shadowed bindings
 149 extendLinkEnv new_bindings
 150   = do  pls <- readIORef v_PersistentLinkerState
 151         let new_closure_env = extendClosureEnv (closure_env pls) new_bindings
 152             new_pls = pls { closure_env = new_closure_env }
 153         writeIORef v_PersistentLinkerState new_pls
 154
 155 deleteFromLinkEnv :: [Name] -> IO ()
 156 deleteFromLinkEnv to_remove
 157   = do  pls <- readIORef v_PersistentLinkerState
 158         let new_closure_env = delListFromNameEnv (closure_env pls) to_remove
 159             new_pls = pls { closure_env = new_closure_env }
 160         writeIORef v_PersistentLinkerState new_pls
 161
 162 -- | Given a data constructor in the heap, find its Name.
 163 --   The info tables for data constructors have a field which records
 164 --   the source name of the constructor as a Ptr Word8 (UTF-8 encoded
 165 --   string). The format is:
 166 --
 167 --    Package:Module.Name
 168 --
 169 --   We use this string to lookup the interpreter's internal representation of the name
 170 --   using the lookupOrig.
 171
 172 dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
 173 dataConInfoPtrToName x = do
 174    theString <- ioToTcRn $ do
 175       let ptr = castPtr x :: Ptr StgInfoTable
 176       conDescAddress <- getConDescAddress ptr
 177       peekArray0 0 conDescAddress
 178    let (pkg, mod, occ) = parse theString
 179        pkgFS = mkFastStringByteList pkg
 180        modFS = mkFastStringByteList mod
 181        occFS = mkFastStringByteList occ
 182        occName = mkOccNameFS OccName.dataName occFS
 183        modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS)
 184    return (Left$ showSDoc$ ppr modName <> dot <> ppr occName )
 185     `recoverM` (Right `fmap` lookupOrig modName occName)
 186
 187    where
 188
 189    {- To find the string in the constructor's info table we need to consider
 190       the layout of info tables relative to the entry code for a closure.
 191
 192       An info table can be next to the entry code for the closure, or it can
 193       be separate. The former (faster) is used in registerised versions of ghc,
 194       and the latter (portable) is for non-registerised versions.
 195
 196       The diagrams below show where the string is to be found relative to
 197       the normal info table of the closure.
 198
 199       1) Code next to table:
 200
 201          --------------
 202          |            |   <- pointer to the start of the string
 203          --------------
 204          |            |   <- the (start of the) info table structure
 205          |            |
 206          |            |
 207          --------------
 208          | entry code |
 209          |    ....    |
 210
 211          In this case the pointer to the start of the string can be found in
 212          the memory location _one word before_ the first entry in the normal info
 213          table.
 214
 215       2) Code NOT next to table:
 216
 217                                  --------------
 218          info table structure -> |     *------------------> --------------
 219                                  |            |             | entry code |
 220                                  |            |             |    ....    |
 221                                  --------------
 222          ptr to start of str ->  |            |
 223                                  --------------
 224
 225          In this case the pointer to the start of the string can be found
 226          in the memory location: info_table_ptr + info_table_size
 227    -}
 228
 229    getConDescAddress :: Ptr StgInfoTable -> IO (Ptr Word8)
 230    getConDescAddress ptr = do
 231 #ifdef GHCI_TABLES_NEXT_TO_CODE
 232        offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
 233        return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord))
 234 #else
 235        peek $ intPtrToPtr $ (ptrToIntPtr ptr) + fromIntegral stdInfoTableSizeB
 236 #endif
 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) $ throwDyn (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               (const 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 (closure_env pls)
 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 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 dflags
 377   = do  {  -- Initialise the linker state
 378         ; writeIORef v_PersistentLinkerState (emptyPLS dflags)
 379
 380                 -- (a) initialise the C dynamic linker
 381         ; initObjLinker
 382
 383                 -- (b) Load packages from the command-line
 384         ; linkPackages dflags (preloadPackages (pkgState dflags))
 385
 386                 -- (c) Link libraries from the command-line
 387         ; let optl = getOpts dflags opt_l
 388         ; let minus_ls = [ lib | '-':'l':lib <- optl ]
 389
 390                 -- (d) Link .o files from the command-line
 391         ; let lib_paths = libraryPaths dflags
 392         ; cmdline_ld_inputs <- readIORef v_Ld_inputs
 393
 394         ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
 395
 396                 -- (e) Link any MacOS frameworks
 397 #ifdef darwin_TARGET_OS
 398         ; let framework_paths = frameworkPaths dflags
 399         ; let frameworks      = cmdlineFrameworks dflags
 400 #else
 401         ; let frameworks      = []
 402         ; let framework_paths = []
 403 #endif
 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 throwDyn (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 #ifdef darwin_TARGET_OS
 449           Framework framework
 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 #endif
 455   where
 456     preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
 457     preloadFailed sys_errmsg paths spec
 458        = do maybePutStr dflags
 459                ("failed.\nDynamic linker error message was:\n   "
 460                     ++ sys_errmsg  ++ "\nWhilst trying to load:  "
 461                     ++ showLS spec ++ "\nDirectories to search are:\n"
 462                     ++ unlines (map ("   "++) paths) )
 463             give_up
 464
 465     -- Not interested in the paths in the static case.
 466     preload_static paths name
 467        = do b <- doesFileExist name
 468             if not b then return False
 469                      else loadObj name >> return True
 470
 471     give_up = throwDyn $
 472               CmdLineError "user specified .o/.so/.DLL could not be loaded."
 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         throwDyn (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 span msg = throwDyn (ProgramError (showSDoc (mkLocMessage span msg)))
 528
 529
 530 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
 531 checkNonStdWay dflags srcspan = do
 532   tag <- readIORef v_Build_tag
 533   if null tag then return Nothing else do
 534   let default_osuf = phaseInputExt StopLn
 535   if objectSuf dflags == default_osuf
 536         then failNonStd srcspan
 537         else return (Just default_osuf)
 538
 539 failNonStd srcspan = dieWith srcspan $
 540   ptext SLIT("Dynamic linking required, but this is a non-standard build (eg. prof).") $$
 541   ptext SLIT("You need to build the program twice: once the normal way, and then") $$
 542   ptext SLIT("in the desired way using -osuf to set the object file suffix.")
 543
 544
 545 getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable
 546             -> Maybe String                     -- the "normal" object suffix
 547             -> SrcSpan                          -- for error messages
 548             -> [Module]                         -- If you need these
 549             -> IO ([Linkable], [PackageId])     -- ... then link these first
 550 -- Fails with an IO exception if it can't find enough files
 551
 552 getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
 553 -- Find all the packages and linkables that a set of modules depends on
 554  = do { pls <- readIORef v_PersistentLinkerState ;
 555         let {
 556         -- 1.  Find the dependent home-pkg-modules/packages from each iface
 557             (mods_s, pkgs_s) = follow_deps mods emptyUniqSet emptyUniqSet;
 558
 559         -- 2.  Exclude ones already linked
 560         --      Main reason: avoid findModule calls in get_linkable
 561             mods_needed = mods_s `minusList` linked_mods     ;
 562             pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 563
 564             linked_mods = map (moduleName.linkableModule)
 565                                 (objs_loaded pls ++ bcos_loaded pls)
 566         } ;
 567
 568 --        putStrLn (showSDoc (ppr mods_s)) ;
 569         -- 3.  For each dependent module, find its linkable
 570         --     This will either be in the HPT or (in the case of one-shot
 571         --     compilation) we may need to use maybe_getFileLinkable
 572         lnks_needed <- mapM (get_linkable maybe_normal_osuf) mods_needed ;
 573
 574         return (lnks_needed, pkgs_needed) }
 575   where
 576     dflags = hsc_dflags hsc_env
 577     this_pkg = thisPackage dflags
 578
 579         -- The ModIface contains the transitive closure of the module dependencies
 580         -- within the current package, *except* for boot modules: if we encounter
 581         -- a boot module, we have to find its real interface and discover the
 582         -- dependencies of that.  Hence we need to traverse the dependency
 583         -- tree recursively.  See bug #936, testcase ghci/prog007.
 584     follow_deps :: [Module]             -- modules to follow
 585                 -> UniqSet ModuleName         -- accum. module dependencies
 586                 -> UniqSet PackageId          -- accum. package dependencies
 587                 -> ([ModuleName], [PackageId]) -- result
 588     follow_deps []     acc_mods acc_pkgs
 589         = (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
 590     follow_deps (mod:mods) acc_mods acc_pkgs
 591         | pkg /= this_pkg
 592         = follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg)
 593         | mi_boot iface
 594         = link_boot_mod_error mod
 595         | otherwise
 596         = follow_deps (map (mkModule this_pkg) boot_deps' ++ mods) acc_mods' acc_pkgs'
 597       where
 598         pkg   = modulePackageId mod
 599         iface = get_iface 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
 612     link_boot_mod_error mod =
 613         throwDyn (ProgramError (showSDoc (
 614             text "module" <+> ppr mod <+>
 615             text "cannot be linked; it is only available as a boot module")))
 616
 617     get_iface mod = case lookupIfaceByModule dflags hpt pit mod of
 618                             Just iface -> iface
 619                             Nothing    -> pprPanic "getLinkDeps" (no_iface mod)
 620     no_iface mod = ptext SLIT("No iface for") <+> ppr mod
 621         -- This one is a GHC bug
 622
 623     no_obj mod = dieWith span $
 624                      ptext SLIT("cannot find object file for module ") <>
 625                         quotes (ppr mod) $$
 626                      while_linking_expr
 627
 628     while_linking_expr = ptext SLIT("while linking an interpreted expression")
 629
 630         -- This one is a build-system bug
 631
 632     get_linkable maybe_normal_osuf mod_name     -- A home-package module
 633         | Just mod_info <- lookupUFM hpt mod_name
 634         = ASSERT(isJust (hm_linkable mod_info))
 635           adjust_linkable (fromJust (hm_linkable mod_info))
 636         | otherwise
 637         = do    -- It's not in the HPT because we are in one shot mode,
 638                 -- so use the Finder to get a ModLocation...
 639              mb_stuff <- findHomeModule hsc_env mod_name
 640              case mb_stuff of
 641                   Found loc mod -> found loc mod
 642                   _ -> no_obj mod_name
 643         where
 644             found loc mod = do {
 645                 -- ...and then find the linkable for it
 646                mb_lnk <- findObjectLinkableMaybe mod loc ;
 647                case mb_lnk of {
 648                   Nothing -> no_obj mod ;
 649                   Just lnk -> adjust_linkable lnk
 650               }}
 651
 652             adjust_linkable lnk
 653                 | Just osuf <- maybe_normal_osuf = do
 654                         new_uls <- mapM (adjust_ul osuf) (linkableUnlinked lnk)
 655                         return lnk{ linkableUnlinked=new_uls }
 656                 | otherwise =
 657                         return lnk
 658
 659             adjust_ul osuf (DotO file) = do
 660                 let new_file = replaceFilenameSuffix file osuf
 661                 ok <- doesFileExist new_file
 662                 if (not ok)
 663                    then dieWith span $
 664                           ptext SLIT("cannot find normal object file ")
 665                                 <> quotes (text new_file) $$ while_linking_expr
 666                    else return (DotO new_file)
 667 \end{code}
 668
 669
 670 %************************************************************************
 671 %*                                                                      *
 672                 Link some linkables
 673         The linkables may consist of a mixture of
 674         byte-code modules and object modules
 675 %*                                                                      *
 676 %************************************************************************
 677
 678 \begin{code}
 679 linkModules :: DynFlags -> [Linkable] -> IO SuccessFlag
 680 linkModules dflags linkables
 681   = block $ do  -- don't want to be interrupted by ^C in here
 682
 683         let (objs, bcos) = partition isObjectLinkable
 684                               (concatMap partitionLinkable linkables)
 685
 686                 -- Load objects first; they can't depend on BCOs
 687         ok_flag <- dynLinkObjs dflags objs
 688
 689         if failed ok_flag then
 690                 return Failed
 691           else do
 692                 dynLinkBCOs bcos
 693                 return Succeeded
 694
 695
 696 -- HACK to support f-x-dynamic in the interpreter; no other purpose
 697 partitionLinkable :: Linkable -> [Linkable]
 698 partitionLinkable li
 699    = let li_uls = linkableUnlinked li
 700          li_uls_obj = filter isObject li_uls
 701          li_uls_bco = filter isInterpretable li_uls
 702      in
 703          case (li_uls_obj, li_uls_bco) of
 704             (objs@(_:_), bcos@(_:_))
 705                -> [li{linkableUnlinked=li_uls_obj}, li{linkableUnlinked=li_uls_bco}]
 706             other
 707                -> [li]
 708
 709 findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 710 findModuleLinkable_maybe lis mod
 711    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
 712         []   -> Nothing
 713         [li] -> Just li
 714         many -> pprPanic "findModuleLinkable" (ppr mod)
 715
 716 linkableInSet :: Linkable -> [Linkable] -> Bool
 717 linkableInSet l objs_loaded =
 718   case findModuleLinkable_maybe objs_loaded (linkableModule l) of
 719         Nothing -> False
 720         Just m  -> linkableTime l == linkableTime m
 721 \end{code}
 722
 723
 724 %************************************************************************
 725 %*                                                                      *
 726 \subsection{The object-code linker}
 727 %*                                                                      *
 728 %************************************************************************
 729
 730 \begin{code}
 731 dynLinkObjs :: DynFlags -> [Linkable] -> IO SuccessFlag
 732         -- Side-effects the PersistentLinkerState
 733
 734 dynLinkObjs dflags objs
 735   = do  pls <- readIORef v_PersistentLinkerState
 736
 737         -- Load the object files and link them
 738         let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
 739             pls1                     = pls { objs_loaded = objs_loaded' }
 740             unlinkeds                = concatMap linkableUnlinked new_objs
 741
 742         mapM loadObj (map nameOfObject unlinkeds)
 743
 744         -- Link the all together
 745         ok <- resolveObjs
 746
 747         -- If resolving failed, unload all our
 748         -- object modules and carry on
 749         if succeeded ok then do
 750                 writeIORef v_PersistentLinkerState pls1
 751                 return Succeeded
 752           else do
 753                 pls2 <- unload_wkr dflags [] pls1
 754                 writeIORef v_PersistentLinkerState pls2
 755                 return Failed
 756
 757
 758 rmDupLinkables :: [Linkable]    -- Already loaded
 759                -> [Linkable]    -- New linkables
 760                -> ([Linkable],  -- New loaded set (including new ones)
 761                    [Linkable])  -- New linkables (excluding dups)
 762 rmDupLinkables already ls
 763   = go already [] ls
 764   where
 765     go already extras [] = (already, extras)
 766     go already extras (l:ls)
 767         | linkableInSet l already = go already     extras     ls
 768         | otherwise               = go (l:already) (l:extras) ls
 769 \end{code}
 770
 771 %************************************************************************
 772 %*                                                                      *
 773 \subsection{The byte-code linker}
 774 %*                                                                      *
 775 %************************************************************************
 776
 777 \begin{code}
 778 dynLinkBCOs :: [Linkable] -> IO ()
 779         -- Side-effects the persistent linker state
 780 dynLinkBCOs bcos
 781   = do  pls <- readIORef v_PersistentLinkerState
 782
 783         let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
 784             pls1                     = pls { bcos_loaded = bcos_loaded' }
 785             unlinkeds :: [Unlinked]
 786             unlinkeds                = concatMap linkableUnlinked new_bcos
 787
 788             cbcs :: [CompiledByteCode]
 789             cbcs      = map byteCodeOfObject unlinkeds
 790
 791
 792             ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
 793             ies        = [ie | ByteCode _ ie <- cbcs]
 794             gce       = closure_env pls
 795             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 796
 797         (final_gce, linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
 798                 -- What happens to these linked_bcos?
 799
 800         let pls2 = pls1 { closure_env = final_gce,
 801                           itbl_env    = final_ie }
 802
 803         writeIORef v_PersistentLinkerState pls2
 804         return ()
 805
 806 -- Link a bunch of BCOs and return them + updated closure env.
 807 linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
 808                         -- True  <=> add only toplevel BCOs to closure env
 809              -> ItblEnv
 810              -> ClosureEnv
 811              -> [UnlinkedBCO]
 812              -> IO (ClosureEnv, [HValue])
 813                         -- The returned HValues are associated 1-1 with
 814                         -- the incoming unlinked BCOs.  Each gives the
 815                         -- value of the corresponding unlinked BCO
 816
 817 linkSomeBCOs toplevs_only ie ce_in ul_bcos
 818    = do let nms = map unlinkedBCOName ul_bcos
 819         hvals <- fixIO
 820                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
 821                                in  mapM (linkBCO ie ce_out) ul_bcos )
 822         let ce_all_additions = zip nms hvals
 823             ce_top_additions = filter (isExternalName.fst) ce_all_additions
 824             ce_additions     = if toplevs_only then ce_top_additions
 825                                                else ce_all_additions
 826             ce_out = -- make sure we're not inserting duplicate names into the
 827                      -- closure environment, which leads to trouble.
 828                      ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
 829                      extendClosureEnv ce_in ce_additions
 830         return (ce_out, hvals)
 831
 832 \end{code}
 833
 834
 835 %************************************************************************
 836 %*                                                                      *
 837                 Unload some object modules
 838 %*                                                                      *
 839 %************************************************************************
 840
 841 \begin{code}
 842 -- ---------------------------------------------------------------------------
 843 -- Unloading old objects ready for a new compilation sweep.
 844 --
 845 -- The compilation manager provides us with a list of linkables that it
 846 -- considers "stable", i.e. won't be recompiled this time around.  For
 847 -- each of the modules current linked in memory,
 848 --
 849 --      * if the linkable is stable (and it's the same one - the
 850 --        user may have recompiled the module on the side), we keep it,
 851 --
 852 --      * otherwise, we unload it.
 853 --
 854 --      * we also implicitly unload all temporary bindings at this point.
 855
 856 unload :: DynFlags -> [Linkable] -> IO ()
 857 -- The 'linkables' are the ones to *keep*
 858
 859 unload dflags linkables
 860   = block $ do -- block, so we're safe from Ctrl-C in here
 861
 862         -- Initialise the linker (if it's not been done already)
 863         initDynLinker dflags
 864
 865         pls     <- readIORef v_PersistentLinkerState
 866         new_pls <- unload_wkr dflags linkables pls
 867         writeIORef v_PersistentLinkerState new_pls
 868
 869         debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
 870         debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
 871         return ()
 872
 873 unload_wkr :: DynFlags
 874            -> [Linkable]                -- stable linkables
 875            -> PersistentLinkerState
 876            -> IO PersistentLinkerState
 877 -- Does the core unload business
 878 -- (the wrapper blocks exceptions and deals with the PLS get and put)
 879
 880 unload_wkr dflags linkables pls
 881   = do  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
 882
 883         objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
 884         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 885
 886         let bcos_retained = map linkableModule bcos_loaded'
 887             itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
 888             closure_env'  = filterNameMap bcos_retained (closure_env pls)
 889             new_pls = pls { itbl_env = itbl_env',
 890                             closure_env = closure_env',
 891                             bcos_loaded = bcos_loaded',
 892                             objs_loaded = objs_loaded' }
 893
 894         return new_pls
 895   where
 896     maybeUnload :: [Linkable] -> Linkable -> IO Bool
 897     maybeUnload keep_linkables lnk
 898       | linkableInSet lnk linkables = return True
 899       | otherwise
 900       = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk]
 901                 -- The components of a BCO linkable may contain
 902                 -- dot-o files.  Which is very confusing.
 903                 --
 904                 -- But the BCO parts can be unlinked just by
 905                 -- letting go of them (plus of course depopulating
 906                 -- the symbol table which is done in the main body)
 907            return False
 908 \end{code}
 909
 910
 911 %************************************************************************
 912 %*                                                                      *
 913                 Loading packages
 914 %*                                                                      *
 915 %************************************************************************
 916
 917
 918 \begin{code}
 919 data LibrarySpec
 920    = Object FilePath    -- Full path name of a .o file, including trailing .o
 921                         -- For dynamic objects only, try to find the object
 922                         -- file in all the directories specified in
 923                         -- v_Library_paths before giving up.
 924
 925    | DLL String         -- "Unadorned" name of a .DLL/.so
 926                         --  e.g.    On unix     "qt"  denotes "libqt.so"
 927                         --          On WinDoze  "burble"  denotes "burble.DLL"
 928                         --  loadDLL is platform-specific and adds the lib/.so/.DLL
 929                         --  suffixes platform-dependently
 930
 931    | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
 932                         -- (ends with .dll or .so).
 933
 934    | Framework String   -- Only used for darwin, but does no harm
 935
 936 -- If this package is already part of the GHCi binary, we'll already
 937 -- have the right DLLs for this package loaded, so don't try to
 938 -- load them again.
 939 --
 940 -- But on Win32 we must load them 'again'; doing so is a harmless no-op
 941 -- as far as the loader is concerned, but it does initialise the list
 942 -- of DLL handles that rts/Linker.c maintains, and that in turn is
 943 -- used by lookupSymbol.  So we must call addDLL for each library
 944 -- just to get the DLL handle into the list.
 945 partOfGHCi
 946 #          if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
 947            = [ ]
 948 #          else
 949            = [ "base", "haskell98", "template-haskell", "readline" ]
 950 #          endif
 951
 952 showLS (Object nm)    = "(static) " ++ nm
 953 showLS (DLL nm)       = "(dynamic) " ++ nm
 954 showLS (DLLPath nm)   = "(dynamic) " ++ nm
 955 showLS (Framework nm) = "(framework) " ++ nm
 956
 957 linkPackages :: DynFlags -> [PackageId] -> IO ()
 958 -- Link exactly the specified packages, and their dependents
 959 -- (unless of course they are already linked)
 960 -- The dependents are linked automatically, and it doesn't matter
 961 -- what order you specify the input packages.
 962 --
 963 -- NOTE: in fact, since each module tracks all the packages it depends on,
 964 --       we don't really need to use the package-config dependencies.
 965 -- However we do need the package-config stuff (to find aux libs etc),
 966 -- and following them lets us load libraries in the right order, which
 967 -- perhaps makes the error message a bit more localised if we get a link
 968 -- failure.  So the dependency walking code is still here.
 969
 970 linkPackages dflags new_pkgs
 971    = do { pls     <- readIORef v_PersistentLinkerState
 972         ; let pkg_map = pkgIdMap (pkgState dflags)
 973
 974         ; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
 975
 976         ; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
 977         }
 978    where
 979      link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
 980      link pkg_map pkgs new_pkgs
 981         = foldM (link_one pkg_map) pkgs new_pkgs
 982
 983      link_one pkg_map pkgs new_pkg
 984         | new_pkg `elem` pkgs   -- Already linked
 985         = return pkgs
 986
 987         | Just pkg_cfg <- lookupPackage pkg_map new_pkg
 988         = do {  -- Link dependents first
 989                pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
 990                 -- Now link the package itself
 991              ; linkPackage dflags pkg_cfg
 992              ; return (new_pkg : pkgs') }
 993
 994         | otherwise
 995         = throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 996
 997
 998 linkPackage :: DynFlags -> PackageConfig -> IO ()
 999 linkPackage dflags pkg
1000    = do
1001         let dirs      =  Packages.libraryDirs pkg
1002
1003         let libs      =  Packages.hsLibraries pkg
1004         -- Because of slight differences between the GHC dynamic linker and
1005         -- the native system linker some packages have to link with a
1006         -- different list of libraries when using GHCi. Examples include: libs
1007         -- that are actually gnu ld scripts, and the possability that the .a
1008         -- libs do not exactly match the .so/.dll equivalents. So if the
1009         -- package file provides an "extra-ghci-libraries" field then we use
1010         -- that instead of the "extra-libraries" field.
1011                       ++ (if null (Packages.extraGHCiLibraries pkg)
1012                             then Packages.extraLibraries pkg
1013                             else Packages.extraGHCiLibraries pkg)
1014                       ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
1015         classifieds   <- mapM (locateOneObj dirs) libs
1016
1017         -- Complication: all the .so's must be loaded before any of the .o's.
1018         let dlls = [ dll | DLL dll    <- classifieds ]
1019             objs = [ obj | Object obj <- classifieds ]
1020
1021         maybePutStr dflags ("Loading package " ++ showPackageId (package pkg) ++ " ... ")
1022
1023         -- See comments with partOfGHCi
1024         when (pkgName (package pkg) `notElem` partOfGHCi) $ do
1025             loadFrameworks pkg
1026             -- When a library A needs symbols from a library B, the order in
1027             -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
1028             -- way ld expects it for static linking. Dynamic linking is a
1029             -- different story: When A has no dependency information for B,
1030             -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
1031             -- when B has not been loaded before. In a nutshell: Reverse the
1032             -- order of DLLs for dynamic linking.
1033             -- This fixes a problem with the HOpenGL package (see "Compiling
1034             -- HOpenGL under recent versions of GHC" on the HOpenGL list).
1035             mapM_ (load_dyn dirs) (reverse dlls)
1036
1037         -- After loading all the DLLs, we can load the static objects.
1038         -- Ordering isn't important here, because we do one final link
1039         -- step to resolve everything.
1040         mapM_ loadObj objs
1041
1042         maybePutStr dflags "linking ... "
1043         ok <- resolveObjs
1044         if succeeded ok then maybePutStrLn dflags "done."
1045               else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'"))
1046
1047 load_dyn dirs dll = do r <- loadDynamic dirs dll
1048                        case r of
1049                          Nothing  -> return ()
1050                          Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: "
1051                                                               ++ dll ++ " (" ++ err ++ ")" ))
1052 #ifndef darwin_TARGET_OS
1053 loadFrameworks pkg = return ()
1054 #else
1055 loadFrameworks pkg = mapM_ load frameworks
1056   where
1057     fw_dirs    = Packages.frameworkDirs pkg
1058     frameworks = Packages.frameworks pkg
1059
1060     load fw = do  r <- loadFramework fw_dirs fw
1061                   case r of
1062                     Nothing  -> return ()
1063                     Just err -> throwDyn (CmdLineError ("can't load framework: "
1064                                                         ++ fw ++ " (" ++ err ++ ")" ))
1065 #endif
1066
1067 -- Try to find an object file for a given library in the given paths.
1068 -- If it isn't present, we assume it's a dynamic library.
1069 #ifndef __PIC__
1070 -- When the GHC package was not compiled as dynamic library (=__PIC__ not set),
1071 -- we search for .o libraries first.
1072 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
1073 locateOneObj dirs lib
1074   = do  { mb_obj_path <- findFile mk_obj_path dirs
1075         ; case mb_obj_path of
1076             Just obj_path -> return (Object obj_path)
1077             Nothing       ->
1078                 do { mb_lib_path <- findFile mk_dyn_lib_path dirs
1079                    ; case mb_lib_path of
1080                        Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
1081                        Nothing       -> return (DLL lib) }}             -- We assume
1082    where
1083      mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
1084      mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
1085 #else
1086 -- When the GHC package was compiled as dynamic library (=__PIC__ set),
1087 -- we search for .so libraries first.
1088 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
1089 locateOneObj dirs lib
1090   = do  { mb_lib_path <- findFile mk_dyn_lib_path dirs
1091         ; case mb_lib_path of
1092             Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
1093             Nothing       ->
1094                 do { mb_obj_path <- findFile mk_obj_path dirs
1095                    ; case mb_obj_path of
1096                        Just obj_path -> return (Object obj_path)
1097                        Nothing       -> return (DLL lib) }}             -- We assume
1098    where
1099      mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
1100      mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
1101 #endif
1102
1103 -- ----------------------------------------------------------------------------
1104 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
1105
1106 -- return Nothing == success, else Just error message from dlopen
1107 loadDynamic paths rootname
1108   = do  { mb_dll <- findFile mk_dll_path paths
1109         ; case mb_dll of
1110             Just dll -> loadDLL dll
1111             Nothing  -> loadDLL (mkSOName rootname) }
1112                         -- Tried all our known library paths, so let
1113                         -- dlopen() search its own builtin paths now.
1114   where
1115     mk_dll_path dir = dir `joinFileName` mkSOName rootname
1116
1117 #if defined(darwin_TARGET_OS)
1118 mkSOName root = ("lib" ++ root) `joinFileExt` "dylib"
1119 #elif defined(mingw32_TARGET_OS)
1120 -- Win32 DLLs have no .dll extension here, because addDLL tries
1121 -- both foo.dll and foo.drv
1122 mkSOName root = root
1123 #else
1124 mkSOName root = ("lib" ++ root) `joinFileExt` "so"
1125 #endif
1126
1127 -- Darwin / MacOS X only: load a framework
1128 -- a framework is a dynamic library packaged inside a directory of the same
1129 -- name. They are searched for in different paths than normal libraries.
1130 #ifdef darwin_TARGET_OS
1131 loadFramework extraPaths rootname
1132    = do { mb_fwk <- findFile mk_fwk (extraPaths ++ defaultFrameworkPaths)
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 `joinFileName` (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 #endif
1143 \end{code}
1144
1145 %************************************************************************
1146 %*                                                                      *
1147                 Helper functions
1148 %*                                                                      *
1149 %************************************************************************
1150
1151 \begin{code}
1152 findFile :: (FilePath -> FilePath)      -- Maps a directory path to a file path
1153          -> [FilePath]                  -- Directories to look in
1154          -> IO (Maybe FilePath)         -- The first file path to match
1155 findFile mk_file_path []
1156   = return Nothing
1157 findFile mk_file_path (dir:dirs)
1158   = do  { let file_path = mk_file_path dir
1159         ; b <- doesFileExist file_path
1160         ; if b then
1161              return (Just file_path)
1162           else
1163              findFile mk_file_path dirs }
1164 \end{code}
1165
1166 \begin{code}
1167 maybePutStr dflags s | verbosity dflags > 0 = putStr s
1168                      | otherwise            = return ()
1169
1170 maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
1171                        | otherwise            = return ()
1172 \end{code}