compiler/ghci/Linker.lhs

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