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