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