1{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-} 2{-# LANGUAGE BangPatterns #-} 3 4-- 5-- (c) The University of Glasgow 2002-2006 6-- 7-- | The dynamic linker for GHCi. 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. 12module Linker ( getHValue, showLinkerState, 13 linkExpr, linkDecls, unload, withExtendedLinkEnv, 14 extendLinkEnv, deleteFromLinkEnv, 15 extendLoadedPkgs, 16 linkPackages, initDynLinker, linkModule, 17 linkCmdLineLibs, 18 uninitializedLinker 19 ) where 20 21#include "HsVersions.h" 22 23import GhcPrelude 24 25import GHCi 26import GHCi.RemoteTypes 27import LoadIface 28import ByteCodeLink 29import ByteCodeAsm 30import ByteCodeTypes 31import TcRnMonad 32import Packages 33import DriverPhases 34import Finder 35import HscTypes 36import Name 37import NameEnv 38import Module 39import ListSetOps 40import LinkerTypes (DynLinker(..), LinkerUnitId, PersistentLinkerState(..)) 41import DynFlags 42import BasicTypes 43import Outputable 44import Panic 45import Util 46import ErrUtils 47import SrcLoc 48import qualified Maybes 49import UniqDSet 50import FastString 51import GHC.Platform 52import SysTools 53import FileCleanup 54 55-- Standard libraries 56import Control.Monad 57 58import Data.Char (isSpace) 59import Data.IORef 60import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition) 61import Data.Maybe 62import Control.Concurrent.MVar 63 64import System.FilePath 65import System.Directory 66import System.IO.Unsafe 67import System.Environment (lookupEnv) 68 69#if defined(mingw32_HOST_OS) 70import System.Win32.Info (getSystemDirectory) 71#endif 72 73import Exception 74 75{- ********************************************************************** 76 77 The Linker's state 78 79 ********************************************************************* -} 80 81{- 82The persistent linker state *must* match the actual state of the 83C dynamic linker at all times. 84 85The MVar used to hold the PersistentLinkerState contains a Maybe 86PersistentLinkerState. The MVar serves to ensure mutual exclusion between 87multiple loaded copies of the GHC library. The Maybe may be Nothing to 88indicate that the linker has not yet been initialised. 89 90The PersistentLinkerState maps Names to actual closures (for 91interpreted code only), for use during linking. 92-} 93 94uninitializedLinker :: IO DynLinker 95uninitializedLinker = 96 newMVar Nothing >>= (pure . DynLinker) 97 98uninitialised :: a 99uninitialised = panic "Dynamic linker not initialised" 100 101modifyPLS_ :: DynLinker -> (PersistentLinkerState -> IO PersistentLinkerState) -> IO () 102modifyPLS_ dl f = 103 modifyMVar_ (dl_mpls dl) (fmap pure . f . fromMaybe uninitialised) 104 105modifyPLS :: DynLinker -> (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a 106modifyPLS dl f = 107 modifyMVar (dl_mpls dl) (fmapFst pure . f . fromMaybe uninitialised) 108 where fmapFst f = fmap (\(x, y) -> (f x, y)) 109 110readPLS :: DynLinker -> IO PersistentLinkerState 111readPLS dl = 112 (fmap (fromMaybe uninitialised) . readMVar) (dl_mpls dl) 113 114modifyMbPLS_ 115 :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO () 116modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f 117 118emptyPLS :: DynFlags -> PersistentLinkerState 119emptyPLS _ = PersistentLinkerState { 120 closure_env = emptyNameEnv, 121 itbl_env = emptyNameEnv, 122 pkgs_loaded = init_pkgs, 123 bcos_loaded = [], 124 objs_loaded = [], 125 temp_sos = [] } 126 127 -- Packages that don't need loading, because the compiler 128 -- shares them with the interpreted program. 129 -- 130 -- The linker's symbol table is populated with RTS symbols using an 131 -- explicit list. See rts/Linker.c for details. 132 where init_pkgs = map toInstalledUnitId [rtsUnitId] 133 134extendLoadedPkgs :: DynLinker -> [InstalledUnitId] -> IO () 135extendLoadedPkgs dl pkgs = 136 modifyPLS_ dl $ \s -> 137 return s{ pkgs_loaded = pkgs ++ pkgs_loaded s } 138 139extendLinkEnv :: DynLinker -> [(Name,ForeignHValue)] -> IO () 140extendLinkEnv dl new_bindings = 141 modifyPLS_ dl $ \pls@PersistentLinkerState{..} -> do 142 let new_ce = extendClosureEnv closure_env new_bindings 143 return $! pls{ closure_env = new_ce } 144 -- strictness is important for not retaining old copies of the pls 145 146deleteFromLinkEnv :: DynLinker -> [Name] -> IO () 147deleteFromLinkEnv dl to_remove = 148 modifyPLS_ dl $ \pls -> do 149 let ce = closure_env pls 150 let new_ce = delListFromNameEnv ce to_remove 151 return pls{ closure_env = new_ce } 152 153-- | Get the 'HValue' associated with the given name. 154-- 155-- May cause loading the module that contains the name. 156-- 157-- Throws a 'ProgramError' if loading fails or the name cannot be found. 158getHValue :: HscEnv -> Name -> IO ForeignHValue 159getHValue hsc_env name = do 160 let dl = hsc_dynLinker hsc_env 161 initDynLinker hsc_env 162 pls <- modifyPLS dl $ \pls -> do 163 if (isExternalName name) then do 164 (pls', ok) <- linkDependencies hsc_env pls noSrcSpan 165 [nameModule name] 166 if (failed ok) then throwGhcExceptionIO (ProgramError "") 167 else return (pls', pls') 168 else 169 return (pls, pls) 170 case lookupNameEnv (closure_env pls) name of 171 Just (_,aa) -> return aa 172 Nothing 173 -> ASSERT2(isExternalName name, ppr name) 174 do let sym_to_find = nameToCLabel name "closure" 175 m <- lookupClosure hsc_env (unpackFS sym_to_find) 176 case m of 177 Just hvref -> mkFinalizedHValue hsc_env hvref 178 Nothing -> linkFail "ByteCodeLink.lookupCE" 179 (unpackFS sym_to_find) 180 181linkDependencies :: HscEnv -> PersistentLinkerState 182 -> SrcSpan -> [Module] 183 -> IO (PersistentLinkerState, SuccessFlag) 184linkDependencies hsc_env pls span needed_mods = do 185-- initDynLinker (hsc_dflags hsc_env) dl 186 let hpt = hsc_HPT hsc_env 187 dflags = hsc_dflags hsc_env 188 -- The interpreter and dynamic linker can only handle object code built 189 -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. 190 -- So here we check the build tag: if we're building a non-standard way 191 -- then we need to find & link object files built the "normal" way. 192 maybe_normal_osuf <- checkNonStdWay dflags span 193 194 -- Find what packages and linkables are required 195 (lnks, pkgs) <- getLinkDeps hsc_env hpt pls 196 maybe_normal_osuf span needed_mods 197 198 -- Link the packages and modules required 199 pls1 <- linkPackages' hsc_env pkgs pls 200 linkModules hsc_env pls1 lnks 201 202 203-- | Temporarily extend the linker state. 204 205withExtendedLinkEnv :: (ExceptionMonad m) => 206 DynLinker -> [(Name,ForeignHValue)] -> m a -> m a 207withExtendedLinkEnv dl new_env action 208 = gbracket (liftIO $ extendLinkEnv dl new_env) 209 (\_ -> reset_old_env) 210 (\_ -> action) 211 where 212 -- Remember that the linker state might be side-effected 213 -- during the execution of the IO action, and we don't want to 214 -- lose those changes (we might have linked a new module or 215 -- package), so the reset action only removes the names we 216 -- added earlier. 217 reset_old_env = liftIO $ do 218 modifyPLS_ dl $ \pls -> 219 let cur = closure_env pls 220 new = delListFromNameEnv cur (map fst new_env) 221 in return pls{ closure_env = new } 222 223 224-- | Display the persistent linker state. 225showLinkerState :: DynLinker -> DynFlags -> IO () 226showLinkerState dl dflags 227 = do pls <- readPLS dl 228 putLogMsg dflags NoReason SevDump noSrcSpan 229 (defaultDumpStyle dflags) 230 (vcat [text "----- Linker state -----", 231 text "Pkgs:" <+> ppr (pkgs_loaded pls), 232 text "Objs:" <+> ppr (objs_loaded pls), 233 text "BCOs:" <+> ppr (bcos_loaded pls)]) 234 235 236{- ********************************************************************** 237 238 Initialisation 239 240 ********************************************************************* -} 241 242-- | Initialise the dynamic linker. This entails 243-- 244-- a) Calling the C initialisation procedure, 245-- 246-- b) Loading any packages specified on the command line, 247-- 248-- c) Loading any packages specified on the command line, now held in the 249-- @-l@ options in @v_Opt_l@, 250-- 251-- d) Loading any @.o\/.dll@ files specified on the command line, now held 252-- in @ldInputs@, 253-- 254-- e) Loading any MacOS frameworks. 255-- 256-- NOTE: This function is idempotent; if called more than once, it does 257-- nothing. This is useful in Template Haskell, where we call it before 258-- trying to link. 259-- 260initDynLinker :: HscEnv -> IO () 261initDynLinker hsc_env = do 262 let dl = hsc_dynLinker hsc_env 263 modifyMbPLS_ dl $ \pls -> do 264 case pls of 265 Just _ -> return pls 266 Nothing -> Just <$> reallyInitDynLinker hsc_env 267 268reallyInitDynLinker :: HscEnv -> IO PersistentLinkerState 269reallyInitDynLinker hsc_env = do 270 -- Initialise the linker state 271 let dflags = hsc_dflags hsc_env 272 pls0 = emptyPLS dflags 273 274 -- (a) initialise the C dynamic linker 275 initObjLinker hsc_env 276 277 -- (b) Load packages from the command-line (Note [preload packages]) 278 pls <- linkPackages' hsc_env (preloadPackages (pkgState dflags)) pls0 279 280 -- steps (c), (d) and (e) 281 linkCmdLineLibs' hsc_env pls 282 283 284linkCmdLineLibs :: HscEnv -> IO () 285linkCmdLineLibs hsc_env = do 286 let dl = hsc_dynLinker hsc_env 287 initDynLinker hsc_env 288 modifyPLS_ dl $ \pls -> do 289 linkCmdLineLibs' hsc_env pls 290 291linkCmdLineLibs' :: HscEnv -> PersistentLinkerState -> IO PersistentLinkerState 292linkCmdLineLibs' hsc_env pls = 293 do 294 let dflags@(DynFlags { ldInputs = cmdline_ld_inputs 295 , libraryPaths = lib_paths_base}) 296 = hsc_dflags hsc_env 297 298 -- (c) Link libraries from the command-line 299 let minus_ls_1 = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ] 300 301 -- On Windows we want to add libpthread by default just as GCC would. 302 -- However because we don't know the actual name of pthread's dll we 303 -- need to defer this to the locateLib call so we can't initialize it 304 -- inside of the rts. Instead we do it here to be able to find the 305 -- import library for pthreads. See #13210. 306 let platform = targetPlatform dflags 307 os = platformOS platform 308 minus_ls = case os of 309 OSMinGW32 -> "pthread" : minus_ls_1 310 _ -> minus_ls_1 311 -- See Note [Fork/Exec Windows] 312 gcc_paths <- getGCCPaths dflags os 313 314 lib_paths_env <- addEnvPaths "LIBRARY_PATH" lib_paths_base 315 316 maybePutStrLn dflags "Search directories (user):" 317 maybePutStr dflags (unlines $ map (" "++) lib_paths_env) 318 maybePutStrLn dflags "Search directories (gcc):" 319 maybePutStr dflags (unlines $ map (" "++) gcc_paths) 320 321 libspecs 322 <- mapM (locateLib hsc_env False lib_paths_env gcc_paths) minus_ls 323 324 -- (d) Link .o files from the command-line 325 classified_ld_inputs <- mapM (classifyLdInput dflags) 326 [ f | FileOption _ f <- cmdline_ld_inputs ] 327 328 -- (e) Link any MacOS frameworks 329 let platform = targetPlatform dflags 330 let (framework_paths, frameworks) = 331 if platformUsesFrameworks platform 332 then (frameworkPaths dflags, cmdlineFrameworks dflags) 333 else ([],[]) 334 335 -- Finally do (c),(d),(e) 336 let cmdline_lib_specs = catMaybes classified_ld_inputs 337 ++ libspecs 338 ++ map Framework frameworks 339 if null cmdline_lib_specs then return pls 340 else do 341 342 -- Add directories to library search paths, this only has an effect 343 -- on Windows. On Unix OSes this function is a NOP. 344 let all_paths = let paths = takeDirectory (pgm_c dflags) 345 : framework_paths 346 ++ lib_paths_base 347 ++ [ takeDirectory dll | DLLPath dll <- libspecs ] 348 in nub $ map normalise paths 349 let lib_paths = nub $ lib_paths_base ++ gcc_paths 350 all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths 351 pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env 352 353 let merged_specs = mergeStaticObjects cmdline_lib_specs 354 pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls 355 merged_specs 356 357 maybePutStr dflags "final link ... " 358 ok <- resolveObjs hsc_env 359 360 -- DLLs are loaded, reset the search paths 361 mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache 362 363 if succeeded ok then maybePutStrLn dflags "done" 364 else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed") 365 366 return pls1 367 368-- | Merge runs of consecutive of 'Objects'. This allows for resolution of 369-- cyclic symbol references when dynamically linking. Specifically, we link 370-- together all of the static objects into a single shared object, avoiding 371-- the issue we saw in #13786. 372mergeStaticObjects :: [LibrarySpec] -> [LibrarySpec] 373mergeStaticObjects specs = go [] specs 374 where 375 go :: [FilePath] -> [LibrarySpec] -> [LibrarySpec] 376 go accum (Objects objs : rest) = go (objs ++ accum) rest 377 go accum@(_:_) rest = Objects (reverse accum) : go [] rest 378 go [] (spec:rest) = spec : go [] rest 379 go [] [] = [] 380 381{- Note [preload packages] 382 383Why do we need to preload packages from the command line? This is an 384explanation copied from #2437: 385 386I tried to implement the suggestion from #3560, thinking it would be 387easy, but there are two reasons we link in packages eagerly when they 388are mentioned on the command line: 389 390 * So that you can link in extra object files or libraries that 391 depend on the packages. e.g. ghc -package foo -lbar where bar is a 392 C library that depends on something in foo. So we could link in 393 foo eagerly if and only if there are extra C libs or objects to 394 link in, but.... 395 396 * Haskell code can depend on a C function exported by a package, and 397 the normal dependency tracking that TH uses can't know about these 398 dependencies. The test ghcilink004 relies on this, for example. 399 400I conclude that we need two -package flags: one that says "this is a 401package I want to make available", and one that says "this is a 402package I want to link in eagerly". Would that be too complicated for 403users? 404-} 405 406classifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec) 407classifyLdInput dflags f 408 | isObjectFilename platform f = return (Just (Objects [f])) 409 | isDynLibFilename platform f = return (Just (DLLPath f)) 410 | otherwise = do 411 putLogMsg dflags NoReason SevInfo noSrcSpan 412 (defaultUserStyle dflags) 413 (text ("Warning: ignoring unrecognised input `" ++ f ++ "'")) 414 return Nothing 415 where platform = targetPlatform dflags 416 417preloadLib 418 :: HscEnv -> [String] -> [String] -> PersistentLinkerState 419 -> LibrarySpec -> IO PersistentLinkerState 420preloadLib hsc_env lib_paths framework_paths pls lib_spec = do 421 maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ") 422 case lib_spec of 423 Objects static_ishs -> do 424 (b, pls1) <- preload_statics lib_paths static_ishs 425 maybePutStrLn dflags (if b then "done" else "not found") 426 return pls1 427 428 Archive static_ish -> do 429 b <- preload_static_archive lib_paths static_ish 430 maybePutStrLn dflags (if b then "done" else "not found") 431 return pls 432 433 DLL dll_unadorned -> do 434 maybe_errstr <- loadDLL hsc_env (mkSOName platform dll_unadorned) 435 case maybe_errstr of 436 Nothing -> maybePutStrLn dflags "done" 437 Just mm | platformOS platform /= OSDarwin -> 438 preloadFailed mm lib_paths lib_spec 439 Just mm | otherwise -> do 440 -- As a backup, on Darwin, try to also load a .so file 441 -- since (apparently) some things install that way - see 442 -- ticket #8770. 443 let libfile = ("lib" ++ dll_unadorned) <.> "so" 444 err2 <- loadDLL hsc_env libfile 445 case err2 of 446 Nothing -> maybePutStrLn dflags "done" 447 Just _ -> preloadFailed mm lib_paths lib_spec 448 return pls 449 450 DLLPath dll_path -> do 451 do maybe_errstr <- loadDLL hsc_env dll_path 452 case maybe_errstr of 453 Nothing -> maybePutStrLn dflags "done" 454 Just mm -> preloadFailed mm lib_paths lib_spec 455 return pls 456 457 Framework framework -> 458 if platformUsesFrameworks (targetPlatform dflags) 459 then do maybe_errstr <- loadFramework hsc_env framework_paths framework 460 case maybe_errstr of 461 Nothing -> maybePutStrLn dflags "done" 462 Just mm -> preloadFailed mm framework_paths lib_spec 463 return pls 464 else panic "preloadLib Framework" 465 466 where 467 dflags = hsc_dflags hsc_env 468 469 platform = targetPlatform dflags 470 471 preloadFailed :: String -> [String] -> LibrarySpec -> IO () 472 preloadFailed sys_errmsg paths spec 473 = do maybePutStr dflags "failed.\n" 474 throwGhcExceptionIO $ 475 CmdLineError ( 476 "user specified .o/.so/.DLL could not be loaded (" 477 ++ sys_errmsg ++ ")\nWhilst trying to load: " 478 ++ showLS spec ++ "\nAdditional directories searched:" 479 ++ (if null paths then " (none)" else 480 intercalate "\n" (map (" "++) paths))) 481 482 -- Not interested in the paths in the static case. 483 preload_statics _paths names 484 = do b <- or <$> mapM doesFileExist names 485 if not b then return (False, pls) 486 else if dynamicGhc 487 then do pls1 <- dynLoadObjs hsc_env pls names 488 return (True, pls1) 489 else do mapM_ (loadObj hsc_env) names 490 return (True, pls) 491 492 preload_static_archive _paths name 493 = do b <- doesFileExist name 494 if not b then return False 495 else do if dynamicGhc 496 then throwGhcExceptionIO $ 497 CmdLineError dynamic_msg 498 else loadArchive hsc_env name 499 return True 500 where 501 dynamic_msg = unlines 502 [ "User-specified static library could not be loaded (" 503 ++ name ++ ")" 504 , "Loading static libraries is not supported in this configuration." 505 , "Try using a dynamic library instead." 506 ] 507 508 509{- ********************************************************************** 510 511 Link a byte-code expression 512 513 ********************************************************************* -} 514 515-- | Link a single expression, /including/ first linking packages and 516-- modules that this expression depends on. 517-- 518-- Raises an IO exception ('ProgramError') if it can't find a compiled 519-- version of the dependents to link. 520-- 521linkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO ForeignHValue 522linkExpr hsc_env span root_ul_bco 523 = do { 524 -- Initialise the linker (if it's not been done already) 525 ; initDynLinker hsc_env 526 527 -- Extract the DynLinker value for passing into required places 528 ; let dl = hsc_dynLinker hsc_env 529 530 -- Take lock for the actual work. 531 ; modifyPLS dl $ \pls0 -> do { 532 533 -- Link the packages and modules required 534 ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods 535 ; if failed ok then 536 throwGhcExceptionIO (ProgramError "") 537 else do { 538 539 -- Link the expression itself 540 let ie = itbl_env pls 541 ce = closure_env pls 542 543 -- Link the necessary packages and linkables 544 545 ; let nobreakarray = error "no break array" 546 bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] 547 ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco 548 ; [root_hvref] <- createBCOs hsc_env [resolved] 549 ; fhv <- mkFinalizedHValue hsc_env root_hvref 550 ; return (pls, fhv) 551 }}} 552 where 553 free_names = uniqDSetToList (bcoFreeNames root_ul_bco) 554 555 needed_mods :: [Module] 556 needed_mods = [ nameModule n | n <- free_names, 557 isExternalName n, -- Names from other modules 558 not (isWiredInName n) -- Exclude wired-in names 559 ] -- (see note below) 560 -- Exclude wired-in names because we may not have read 561 -- their interface files, so getLinkDeps will fail 562 -- All wired-in names are in the base package, which we link 563 -- by default, so we can safely ignore them here. 564 565dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a 566dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg))) 567 568 569checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath) 570checkNonStdWay dflags srcspan 571 | gopt Opt_ExternalInterpreter dflags = return Nothing 572 -- with -fexternal-interpreter we load the .o files, whatever way 573 -- they were built. If they were built for a non-std way, then 574 -- we will use the appropriate variant of the iserv binary to load them. 575 576 | interpWays == haskellWays = return Nothing 577 -- Only if we are compiling with the same ways as GHC is built 578 -- with, can we dynamically load those object files. (see #3604) 579 580 | objectSuf dflags == normalObjectSuffix && not (null haskellWays) 581 = failNonStd dflags srcspan 582 583 | otherwise = return (Just (interpTag ++ "o")) 584 where 585 haskellWays = filter (not . wayRTSOnly) (ways dflags) 586 interpTag = case mkBuildTag interpWays of 587 "" -> "" 588 tag -> tag ++ "_" 589 590normalObjectSuffix :: String 591normalObjectSuffix = phaseInputExt StopLn 592 593failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath) 594failNonStd dflags srcspan = dieWith dflags srcspan $ 595 text "Cannot load" <+> compWay <+> 596 text "objects when GHC is built" <+> ghciWay $$ 597 text "To fix this, either:" $$ 598 text " (1) Use -fexternal-interpreter, or" $$ 599 text " (2) Build the program twice: once" <+> 600 ghciWay <> text ", and then" $$ 601 text " with" <+> compWay <+> 602 text "using -osuf to set a different object file suffix." 603 where compWay 604 | WayDyn `elem` ways dflags = text "-dynamic" 605 | WayProf `elem` ways dflags = text "-prof" 606 | otherwise = text "normal" 607 ghciWay 608 | dynamicGhc = text "with -dynamic" 609 | rtsIsProfiled = text "with -prof" 610 | otherwise = text "the normal way" 611 612getLinkDeps :: HscEnv -> HomePackageTable 613 -> PersistentLinkerState 614 -> Maybe FilePath -- replace object suffices? 615 -> SrcSpan -- for error messages 616 -> [Module] -- If you need these 617 -> IO ([Linkable], [InstalledUnitId]) -- ... then link these first 618-- Fails with an IO exception if it can't find enough files 619 620getLinkDeps hsc_env hpt pls replace_osuf span mods 621-- Find all the packages and linkables that a set of modules depends on 622 = do { 623 -- 1. Find the dependent home-pkg-modules/packages from each iface 624 -- (omitting modules from the interactive package, which is already linked) 625 ; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods) 626 emptyUniqDSet emptyUniqDSet; 627 628 ; let { 629 -- 2. Exclude ones already linked 630 -- Main reason: avoid findModule calls in get_linkable 631 mods_needed = mods_s `minusList` linked_mods ; 632 pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ; 633 634 linked_mods = map (moduleName.linkableModule) 635 (objs_loaded pls ++ bcos_loaded pls) } 636 637 -- 3. For each dependent module, find its linkable 638 -- This will either be in the HPT or (in the case of one-shot 639 -- compilation) we may need to use maybe_getFileLinkable 640 ; let { osuf = objectSuf dflags } 641 ; lnks_needed <- mapM (get_linkable osuf) mods_needed 642 643 ; return (lnks_needed, pkgs_needed) } 644 where 645 dflags = hsc_dflags hsc_env 646 this_pkg = thisPackage dflags 647 648 -- The ModIface contains the transitive closure of the module dependencies 649 -- within the current package, *except* for boot modules: if we encounter 650 -- a boot module, we have to find its real interface and discover the 651 -- dependencies of that. Hence we need to traverse the dependency 652 -- tree recursively. See bug #936, testcase ghci/prog007. 653 follow_deps :: [Module] -- modules to follow 654 -> UniqDSet ModuleName -- accum. module dependencies 655 -> UniqDSet InstalledUnitId -- accum. package dependencies 656 -> IO ([ModuleName], [InstalledUnitId]) -- result 657 follow_deps [] acc_mods acc_pkgs 658 = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs) 659 follow_deps (mod:mods) acc_mods acc_pkgs 660 = do 661 mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ 662 loadInterface msg mod (ImportByUser False) 663 iface <- case mb_iface of 664 Maybes.Failed err -> throwGhcExceptionIO (ProgramError (showSDoc dflags err)) 665 Maybes.Succeeded iface -> return iface 666 667 when (mi_boot iface) $ link_boot_mod_error mod 668 669 let 670 pkg = moduleUnitId mod 671 deps = mi_deps iface 672 673 pkg_deps = dep_pkgs deps 674 (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps) 675 where is_boot (m,True) = Left m 676 is_boot (m,False) = Right m 677 678 boot_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) boot_deps 679 acc_mods' = addListToUniqDSet acc_mods (moduleName mod : mod_deps) 680 acc_pkgs' = addListToUniqDSet acc_pkgs $ map fst pkg_deps 681 -- 682 if pkg /= this_pkg 683 then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toInstalledUnitId pkg)) 684 else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods) 685 acc_mods' acc_pkgs' 686 where 687 msg = text "need to link module" <+> ppr mod <+> 688 text "due to use of Template Haskell" 689 690 691 link_boot_mod_error mod = 692 throwGhcExceptionIO (ProgramError (showSDoc dflags ( 693 text "module" <+> ppr mod <+> 694 text "cannot be linked; it is only available as a boot module"))) 695 696 no_obj :: Outputable a => a -> IO b 697 no_obj mod = dieWith dflags span $ 698 text "cannot find object file for module " <> 699 quotes (ppr mod) $$ 700 while_linking_expr 701 702 while_linking_expr = text "while linking an interpreted expression" 703 704 -- This one is a build-system bug 705 706 get_linkable osuf mod_name -- A home-package module 707 | Just mod_info <- lookupHpt hpt mod_name 708 = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info)) 709 | otherwise 710 = do -- It's not in the HPT because we are in one shot mode, 711 -- so use the Finder to get a ModLocation... 712 mb_stuff <- findHomeModule hsc_env mod_name 713 case mb_stuff of 714 Found loc mod -> found loc mod 715 _ -> no_obj mod_name 716 where 717 found loc mod = do { 718 -- ...and then find the linkable for it 719 mb_lnk <- findObjectLinkableMaybe mod loc ; 720 case mb_lnk of { 721 Nothing -> no_obj mod ; 722 Just lnk -> adjust_linkable lnk 723 }} 724 725 adjust_linkable lnk 726 | Just new_osuf <- replace_osuf = do 727 new_uls <- mapM (adjust_ul new_osuf) 728 (linkableUnlinked lnk) 729 return lnk{ linkableUnlinked=new_uls } 730 | otherwise = 731 return lnk 732 733 adjust_ul new_osuf (DotO file) = do 734 MASSERT(osuf `isSuffixOf` file) 735 let file_base = fromJust (stripExtension osuf file) 736 new_file = file_base <.> new_osuf 737 ok <- doesFileExist new_file 738 if (not ok) 739 then dieWith dflags span $ 740 text "cannot find object file " 741 <> quotes (text new_file) $$ while_linking_expr 742 else return (DotO new_file) 743 adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) 744 adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) 745 adjust_ul _ l@(BCOs {}) = return l 746 747 748 749{- ********************************************************************** 750 751 Loading a Decls statement 752 753 ********************************************************************* -} 754 755linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO () 756linkDecls hsc_env span cbc@CompiledByteCode{..} = do 757 -- Initialise the linker (if it's not been done already) 758 initDynLinker hsc_env 759 760 -- Extract the DynLinker for passing into required places 761 let dl = hsc_dynLinker hsc_env 762 763 -- Take lock for the actual work. 764 modifyPLS dl $ \pls0 -> do 765 766 -- Link the packages and modules required 767 (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods 768 if failed ok 769 then throwGhcExceptionIO (ProgramError "") 770 else do 771 772 -- Link the expression itself 773 let ie = plusNameEnv (itbl_env pls) bc_itbls 774 ce = closure_env pls 775 776 -- Link the necessary packages and linkables 777 new_bindings <- linkSomeBCOs hsc_env ie ce [cbc] 778 nms_fhvs <- makeForeignNamedHValueRefs hsc_env new_bindings 779 let pls2 = pls { closure_env = extendClosureEnv ce nms_fhvs 780 , itbl_env = ie } 781 return (pls2, ()) 782 where 783 free_names = uniqDSetToList $ 784 foldr (unionUniqDSets . bcoFreeNames) emptyUniqDSet bc_bcos 785 786 needed_mods :: [Module] 787 needed_mods = [ nameModule n | n <- free_names, 788 isExternalName n, -- Names from other modules 789 not (isWiredInName n) -- Exclude wired-in names 790 ] -- (see note below) 791 -- Exclude wired-in names because we may not have read 792 -- their interface files, so getLinkDeps will fail 793 -- All wired-in names are in the base package, which we link 794 -- by default, so we can safely ignore them here. 795 796{- ********************************************************************** 797 798 Loading a single module 799 800 ********************************************************************* -} 801 802linkModule :: HscEnv -> Module -> IO () 803linkModule hsc_env mod = do 804 initDynLinker hsc_env 805 let dl = hsc_dynLinker hsc_env 806 modifyPLS_ dl $ \pls -> do 807 (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod] 808 if (failed ok) then throwGhcExceptionIO (ProgramError "could not link module") 809 else return pls' 810 811{- ********************************************************************** 812 813 Link some linkables 814 The linkables may consist of a mixture of 815 byte-code modules and object modules 816 817 ********************************************************************* -} 818 819linkModules :: HscEnv -> PersistentLinkerState -> [Linkable] 820 -> IO (PersistentLinkerState, SuccessFlag) 821linkModules hsc_env pls linkables 822 = mask_ $ do -- don't want to be interrupted by ^C in here 823 824 let (objs, bcos) = partition isObjectLinkable 825 (concatMap partitionLinkable linkables) 826 827 -- Load objects first; they can't depend on BCOs 828 (pls1, ok_flag) <- dynLinkObjs hsc_env pls objs 829 830 if failed ok_flag then 831 return (pls1, Failed) 832 else do 833 pls2 <- dynLinkBCOs hsc_env pls1 bcos 834 return (pls2, Succeeded) 835 836 837-- HACK to support f-x-dynamic in the interpreter; no other purpose 838partitionLinkable :: Linkable -> [Linkable] 839partitionLinkable li 840 = let li_uls = linkableUnlinked li 841 li_uls_obj = filter isObject li_uls 842 li_uls_bco = filter isInterpretable li_uls 843 in 844 case (li_uls_obj, li_uls_bco) of 845 (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj}, 846 li {linkableUnlinked=li_uls_bco}] 847 _ -> [li] 848 849findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable 850findModuleLinkable_maybe lis mod 851 = case [LM time nm us | LM time nm us <- lis, nm == mod] of 852 [] -> Nothing 853 [li] -> Just li 854 _ -> pprPanic "findModuleLinkable" (ppr mod) 855 856linkableInSet :: Linkable -> [Linkable] -> Bool 857linkableInSet l objs_loaded = 858 case findModuleLinkable_maybe objs_loaded (linkableModule l) of 859 Nothing -> False 860 Just m -> linkableTime l == linkableTime m 861 862 863{- ********************************************************************** 864 865 The object-code linker 866 867 ********************************************************************* -} 868 869dynLinkObjs :: HscEnv -> PersistentLinkerState -> [Linkable] 870 -> IO (PersistentLinkerState, SuccessFlag) 871dynLinkObjs hsc_env pls objs = do 872 -- Load the object files and link them 873 let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs 874 pls1 = pls { objs_loaded = objs_loaded' } 875 unlinkeds = concatMap linkableUnlinked new_objs 876 wanted_objs = map nameOfObject unlinkeds 877 878 if interpreterDynamic (hsc_dflags hsc_env) 879 then do pls2 <- dynLoadObjs hsc_env pls1 wanted_objs 880 return (pls2, Succeeded) 881 else do mapM_ (loadObj hsc_env) wanted_objs 882 883 -- Link them all together 884 ok <- resolveObjs hsc_env 885 886 -- If resolving failed, unload all our 887 -- object modules and carry on 888 if succeeded ok then do 889 return (pls1, Succeeded) 890 else do 891 pls2 <- unload_wkr hsc_env [] pls1 892 return (pls2, Failed) 893 894 895dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath] 896 -> IO PersistentLinkerState 897dynLoadObjs _ pls [] = return pls 898dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do 899 let dflags = hsc_dflags hsc_env 900 let platform = targetPlatform dflags 901 let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ] 902 let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ] 903 (soFile, libPath , libName) <- 904 newTempLibName dflags TFL_CurrentModule (soExt platform) 905 let 906 dflags2 = dflags { 907 -- We don't want the original ldInputs in 908 -- (they're already linked in), but we do want 909 -- to link against previous dynLoadObjs 910 -- libraries if there were any, so that the linker 911 -- can resolve dependencies when it loads this 912 -- library. 913 ldInputs = 914 concatMap (\l -> [ Option ("-l" ++ l) ]) 915 (nub $ snd <$> temp_sos) 916 ++ concatMap (\lp -> Option ("-L" ++ lp) 917 : if useXLinkerRPath dflags (platformOS platform) 918 then [ Option "-Xlinker" 919 , Option "-rpath" 920 , Option "-Xlinker" 921 , Option lp ] 922 else []) 923 (nub $ fst <$> temp_sos) 924 ++ concatMap 925 (\lp -> Option ("-L" ++ lp) 926 : if useXLinkerRPath dflags (platformOS platform) 927 then [ Option "-Xlinker" 928 , Option "-rpath" 929 , Option "-Xlinker" 930 , Option lp ] 931 else []) 932 minus_big_ls 933 -- See Note [-Xlinker -rpath vs -Wl,-rpath] 934 ++ map (\l -> Option ("-l" ++ l)) minus_ls, 935 -- Add -l options and -L options from dflags. 936 -- 937 -- When running TH for a non-dynamic way, we still 938 -- need to make -l flags to link against the dynamic 939 -- libraries, so we need to add WayDyn to ways. 940 -- 941 -- Even if we're e.g. profiling, we still want 942 -- the vanilla dynamic libraries, so we set the 943 -- ways / build tag to be just WayDyn. 944 ways = [WayDyn], 945 buildTag = mkBuildTag [WayDyn], 946 outputFile = Just soFile 947 } 948 -- link all "loaded packages" so symbols in those can be resolved 949 -- Note: We are loading packages with local scope, so to see the 950 -- symbols in this link we must link all loaded packages again. 951 linkDynLib dflags2 objs pkgs_loaded 952 953 -- if we got this far, extend the lifetime of the library file 954 changeTempFilesLifetime dflags TFL_GhcSession [soFile] 955 m <- loadDLL hsc_env soFile 956 case m of 957 Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } 958 Just err -> panic ("Loading temp shared object failed: " ++ err) 959 960rmDupLinkables :: [Linkable] -- Already loaded 961 -> [Linkable] -- New linkables 962 -> ([Linkable], -- New loaded set (including new ones) 963 [Linkable]) -- New linkables (excluding dups) 964rmDupLinkables already ls 965 = go already [] ls 966 where 967 go already extras [] = (already, extras) 968 go already extras (l:ls) 969 | linkableInSet l already = go already extras ls 970 | otherwise = go (l:already) (l:extras) ls 971 972{- ********************************************************************** 973 974 The byte-code linker 975 976 ********************************************************************* -} 977 978 979dynLinkBCOs :: HscEnv -> PersistentLinkerState -> [Linkable] 980 -> IO PersistentLinkerState 981dynLinkBCOs hsc_env pls bcos = do 982 983 let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos 984 pls1 = pls { bcos_loaded = bcos_loaded' } 985 unlinkeds :: [Unlinked] 986 unlinkeds = concatMap linkableUnlinked new_bcos 987 988 cbcs :: [CompiledByteCode] 989 cbcs = map byteCodeOfObject unlinkeds 990 991 992 ies = map bc_itbls cbcs 993 gce = closure_env pls 994 final_ie = foldr plusNameEnv (itbl_env pls) ies 995 996 names_and_refs <- linkSomeBCOs hsc_env final_ie gce cbcs 997 998 -- We only want to add the external ones to the ClosureEnv 999 let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs 1000 1001 -- Immediately release any HValueRefs we're not going to add 1002 freeHValueRefs hsc_env (map snd to_drop) 1003 -- Wrap finalizers on the ones we want to keep 1004 new_binds <- makeForeignNamedHValueRefs hsc_env to_add 1005 1006 return pls1 { closure_env = extendClosureEnv gce new_binds, 1007 itbl_env = final_ie } 1008 1009-- Link a bunch of BCOs and return references to their values 1010linkSomeBCOs :: HscEnv 1011 -> ItblEnv 1012 -> ClosureEnv 1013 -> [CompiledByteCode] 1014 -> IO [(Name,HValueRef)] 1015 -- The returned HValueRefs are associated 1-1 with 1016 -- the incoming unlinked BCOs. Each gives the 1017 -- value of the corresponding unlinked BCO 1018 1019linkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods [] 1020 where 1021 fun CompiledByteCode{..} inner accum = 1022 case bc_breaks of 1023 Nothing -> inner ((panic "linkSomeBCOs: no break array", bc_bcos) : accum) 1024 Just mb -> withForeignRef (modBreaks_flags mb) $ \breakarray -> 1025 inner ((breakarray, bc_bcos) : accum) 1026 1027 do_link [] = return [] 1028 do_link mods = do 1029 let flat = [ (breakarray, bco) | (breakarray, bcos) <- mods, bco <- bcos ] 1030 names = map (unlinkedBCOName . snd) flat 1031 bco_ix = mkNameEnv (zip names [0..]) 1032 resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco 1033 | (breakarray, bco) <- flat ] 1034 hvrefs <- createBCOs hsc_env resolved 1035 return (zip names hvrefs) 1036 1037-- | Useful to apply to the result of 'linkSomeBCOs' 1038makeForeignNamedHValueRefs 1039 :: HscEnv -> [(Name,HValueRef)] -> IO [(Name,ForeignHValue)] 1040makeForeignNamedHValueRefs hsc_env bindings = 1041 mapM (\(n, hvref) -> (n,) <$> mkFinalizedHValue hsc_env hvref) bindings 1042 1043{- ********************************************************************** 1044 1045 Unload some object modules 1046 1047 ********************************************************************* -} 1048 1049-- --------------------------------------------------------------------------- 1050-- | Unloading old objects ready for a new compilation sweep. 1051-- 1052-- The compilation manager provides us with a list of linkables that it 1053-- considers \"stable\", i.e. won't be recompiled this time around. For 1054-- each of the modules current linked in memory, 1055-- 1056-- * if the linkable is stable (and it's the same one -- the user may have 1057-- recompiled the module on the side), we keep it, 1058-- 1059-- * otherwise, we unload it. 1060-- 1061-- * we also implicitly unload all temporary bindings at this point. 1062-- 1063unload :: HscEnv 1064 -> [Linkable] -- ^ The linkables to *keep*. 1065 -> IO () 1066unload hsc_env linkables 1067 = mask_ $ do -- mask, so we're safe from Ctrl-C in here 1068 1069 -- Initialise the linker (if it's not been done already) 1070 initDynLinker hsc_env 1071 1072 -- Extract DynLinker for passing into required places 1073 let dl = hsc_dynLinker hsc_env 1074 1075 new_pls 1076 <- modifyPLS dl $ \pls -> do 1077 pls1 <- unload_wkr hsc_env linkables pls 1078 return (pls1, pls1) 1079 1080 let dflags = hsc_dflags hsc_env 1081 debugTraceMsg dflags 3 $ 1082 text "unload: retaining objs" <+> ppr (objs_loaded new_pls) 1083 debugTraceMsg dflags 3 $ 1084 text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls) 1085 return () 1086 1087unload_wkr :: HscEnv 1088 -> [Linkable] -- stable linkables 1089 -> PersistentLinkerState 1090 -> IO PersistentLinkerState 1091-- Does the core unload business 1092-- (the wrapper blocks exceptions and deals with the PLS get and put) 1093 1094unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..} = do 1095 -- NB. careful strictness here to avoid keeping the old PLS when 1096 -- we're unloading some code. -fghci-leak-check with the tests in 1097 -- testsuite/ghci can detect space leaks here. 1098 1099 let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable keep_linkables 1100 1101 discard keep l = not (linkableInSet l keep) 1102 1103 (objs_to_unload, remaining_objs_loaded) = 1104 partition (discard objs_to_keep) objs_loaded 1105 (bcos_to_unload, remaining_bcos_loaded) = 1106 partition (discard bcos_to_keep) bcos_loaded 1107 1108 mapM_ unloadObjs objs_to_unload 1109 mapM_ unloadObjs bcos_to_unload 1110 1111 -- If we unloaded any object files at all, we need to purge the cache 1112 -- of lookupSymbol results. 1113 when (not (null (objs_to_unload ++ 1114 filter (not . null . linkableObjs) bcos_to_unload))) $ 1115 purgeLookupSymbolCache hsc_env 1116 1117 let !bcos_retained = mkModuleSet $ map linkableModule remaining_bcos_loaded 1118 1119 -- Note that we want to remove all *local* 1120 -- (i.e. non-isExternal) names too (these are the 1121 -- temporary bindings from the command line). 1122 keep_name (n,_) = isExternalName n && 1123 nameModule n `elemModuleSet` bcos_retained 1124 1125 itbl_env' = filterNameEnv keep_name itbl_env 1126 closure_env' = filterNameEnv keep_name closure_env 1127 1128 !new_pls = pls { itbl_env = itbl_env', 1129 closure_env = closure_env', 1130 bcos_loaded = remaining_bcos_loaded, 1131 objs_loaded = remaining_objs_loaded } 1132 1133 return new_pls 1134 where 1135 unloadObjs :: Linkable -> IO () 1136 unloadObjs lnk 1137 -- The RTS's PEi386 linker currently doesn't support unloading. 1138 | isWindowsHost = return () 1139 1140 | dynamicGhc = return () 1141 -- We don't do any cleanup when linking objects with the 1142 -- dynamic linker. Doing so introduces extra complexity for 1143 -- not much benefit. 1144 1145 | otherwise 1146 = mapM_ (unloadObj hsc_env) [f | DotO f <- linkableUnlinked lnk] 1147 -- The components of a BCO linkable may contain 1148 -- dot-o files. Which is very confusing. 1149 -- 1150 -- But the BCO parts can be unlinked just by 1151 -- letting go of them (plus of course depopulating 1152 -- the symbol table which is done in the main body) 1153 1154{- ********************************************************************** 1155 1156 Loading packages 1157 1158 ********************************************************************* -} 1159 1160data LibrarySpec 1161 = Objects [FilePath] -- Full path names of set of .o files, including trailing .o 1162 -- We allow batched loading to ensure that cyclic symbol 1163 -- references can be resolved (see #13786). 1164 -- For dynamic objects only, try to find the object 1165 -- file in all the directories specified in 1166 -- v_Library_paths before giving up. 1167 1168 | Archive FilePath -- Full path name of a .a file, including trailing .a 1169 1170 | DLL String -- "Unadorned" name of a .DLL/.so 1171 -- e.g. On unix "qt" denotes "libqt.so" 1172 -- On Windows "burble" denotes "burble.DLL" or "libburble.dll" 1173 -- loadDLL is platform-specific and adds the lib/.so/.DLL 1174 -- suffixes platform-dependently 1175 1176 | DLLPath FilePath -- Absolute or relative pathname to a dynamic library 1177 -- (ends with .dll or .so). 1178 1179 | Framework String -- Only used for darwin, but does no harm 1180 1181instance Outputable LibrarySpec where 1182 ppr (Objects objs) = text "Objects" <+> ppr objs 1183 ppr (Archive a) = text "Archive" <+> text a 1184 ppr (DLL s) = text "DLL" <+> text s 1185 ppr (DLLPath f) = text "DLLPath" <+> text f 1186 ppr (Framework s) = text "Framework" <+> text s 1187 1188-- If this package is already part of the GHCi binary, we'll already 1189-- have the right DLLs for this package loaded, so don't try to 1190-- load them again. 1191-- 1192-- But on Win32 we must load them 'again'; doing so is a harmless no-op 1193-- as far as the loader is concerned, but it does initialise the list 1194-- of DLL handles that rts/Linker.c maintains, and that in turn is 1195-- used by lookupSymbol. So we must call addDLL for each library 1196-- just to get the DLL handle into the list. 1197partOfGHCi :: [PackageName] 1198partOfGHCi 1199 | isWindowsHost || isDarwinHost = [] 1200 | otherwise = map (PackageName . mkFastString) 1201 ["base", "template-haskell", "editline"] 1202 1203showLS :: LibrarySpec -> String 1204showLS (Objects nms) = "(static) [" ++ intercalate ", " nms ++ "]" 1205showLS (Archive nm) = "(static archive) " ++ nm 1206showLS (DLL nm) = "(dynamic) " ++ nm 1207showLS (DLLPath nm) = "(dynamic) " ++ nm 1208showLS (Framework nm) = "(framework) " ++ nm 1209 1210-- | Link exactly the specified packages, and their dependents (unless of 1211-- course they are already linked). The dependents are linked 1212-- automatically, and it doesn't matter what order you specify the input 1213-- packages. 1214-- 1215linkPackages :: HscEnv -> [LinkerUnitId] -> IO () 1216-- NOTE: in fact, since each module tracks all the packages it depends on, 1217-- we don't really need to use the package-config dependencies. 1218-- 1219-- However we do need the package-config stuff (to find aux libs etc), 1220-- and following them lets us load libraries in the right order, which 1221-- perhaps makes the error message a bit more localised if we get a link 1222-- failure. So the dependency walking code is still here. 1223 1224linkPackages hsc_env new_pkgs = do 1225 -- It's probably not safe to try to load packages concurrently, so we take 1226 -- a lock. 1227 initDynLinker hsc_env 1228 let dl = hsc_dynLinker hsc_env 1229 modifyPLS_ dl $ \pls -> do 1230 linkPackages' hsc_env new_pkgs pls 1231 1232linkPackages' :: HscEnv -> [LinkerUnitId] -> PersistentLinkerState 1233 -> IO PersistentLinkerState 1234linkPackages' hsc_env new_pks pls = do 1235 pkgs' <- link (pkgs_loaded pls) new_pks 1236 return $! pls { pkgs_loaded = pkgs' } 1237 where 1238 dflags = hsc_dflags hsc_env 1239 1240 link :: [LinkerUnitId] -> [LinkerUnitId] -> IO [LinkerUnitId] 1241 link pkgs new_pkgs = 1242 foldM link_one pkgs new_pkgs 1243 1244 link_one pkgs new_pkg 1245 | new_pkg `elem` pkgs -- Already linked 1246 = return pkgs 1247 1248 | Just pkg_cfg <- lookupInstalledPackage dflags new_pkg 1249 = do { -- Link dependents first 1250 pkgs' <- link pkgs (depends pkg_cfg) 1251 -- Now link the package itself 1252 ; linkPackage hsc_env pkg_cfg 1253 ; return (new_pkg : pkgs') } 1254 1255 | otherwise 1256 = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (installedUnitIdFS new_pkg))) 1257 1258 1259linkPackage :: HscEnv -> PackageConfig -> IO () 1260linkPackage hsc_env pkg 1261 = do 1262 let dflags = hsc_dflags hsc_env 1263 platform = targetPlatform dflags 1264 is_dyn = interpreterDynamic dflags 1265 dirs | is_dyn = Packages.libraryDynDirs pkg 1266 | otherwise = Packages.libraryDirs pkg 1267 1268 let hs_libs = Packages.hsLibraries pkg 1269 -- The FFI GHCi import lib isn't needed as 1270 -- compiler/ghci/Linker.hs + rts/Linker.c link the 1271 -- interpreted references to FFI to the compiled FFI. 1272 -- We therefore filter it out so that we don't get 1273 -- duplicate symbol errors. 1274 hs_libs' = filter ("HSffi" /=) hs_libs 1275 1276 -- Because of slight differences between the GHC dynamic linker and 1277 -- the native system linker some packages have to link with a 1278 -- different list of libraries when using GHCi. Examples include: libs 1279 -- that are actually gnu ld scripts, and the possibility that the .a 1280 -- libs do not exactly match the .so/.dll equivalents. So if the 1281 -- package file provides an "extra-ghci-libraries" field then we use 1282 -- that instead of the "extra-libraries" field. 1283 extra_libs = 1284 (if null (Packages.extraGHCiLibraries pkg) 1285 then Packages.extraLibraries pkg 1286 else Packages.extraGHCiLibraries pkg) 1287 ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ] 1288 -- See Note [Fork/Exec Windows] 1289 gcc_paths <- getGCCPaths dflags (platformOS platform) 1290 dirs_env <- addEnvPaths "LIBRARY_PATH" dirs 1291 1292 hs_classifieds 1293 <- mapM (locateLib hsc_env True dirs_env gcc_paths) hs_libs' 1294 extra_classifieds 1295 <- mapM (locateLib hsc_env False dirs_env gcc_paths) extra_libs 1296 let classifieds = hs_classifieds ++ extra_classifieds 1297 1298 -- Complication: all the .so's must be loaded before any of the .o's. 1299 let known_dlls = [ dll | DLLPath dll <- classifieds ] 1300 dlls = [ dll | DLL dll <- classifieds ] 1301 objs = [ obj | Objects objs <- classifieds 1302 , obj <- objs ] 1303 archs = [ arch | Archive arch <- classifieds ] 1304 1305 -- Add directories to library search paths 1306 let dll_paths = map takeDirectory known_dlls 1307 all_paths = nub $ map normalise $ dll_paths ++ dirs 1308 all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths 1309 pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env 1310 1311 maybePutStr dflags 1312 ("Loading package " ++ sourcePackageIdString pkg ++ " ... ") 1313 1314 -- See comments with partOfGHCi 1315#if defined(CAN_LOAD_DLL) 1316 when (packageName pkg `notElem` partOfGHCi) $ do 1317 loadFrameworks hsc_env platform pkg 1318 -- See Note [Crash early load_dyn and locateLib] 1319 -- Crash early if can't load any of `known_dlls` 1320 mapM_ (load_dyn hsc_env True) known_dlls 1321 -- For remaining `dlls` crash early only when there is surely 1322 -- no package's DLL around ... (not is_dyn) 1323 mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls 1324#endif 1325 -- After loading all the DLLs, we can load the static objects. 1326 -- Ordering isn't important here, because we do one final link 1327 -- step to resolve everything. 1328 mapM_ (loadObj hsc_env) objs 1329 mapM_ (loadArchive hsc_env) archs 1330 1331 maybePutStr dflags "linking ... " 1332 ok <- resolveObjs hsc_env 1333 1334 -- DLLs are loaded, reset the search paths 1335 -- Import libraries will be loaded via loadArchive so only 1336 -- reset the DLL search path after all archives are loaded 1337 -- as well. 1338 mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache 1339 1340 if succeeded ok 1341 then maybePutStrLn dflags "done." 1342 else let errmsg = "unable to load package `" 1343 ++ sourcePackageIdString pkg ++ "'" 1344 in throwGhcExceptionIO (InstallationError errmsg) 1345 1346{- 1347Note [Crash early load_dyn and locateLib] 1348~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1349If a package is "normal" (exposes it's code from more than zero Haskell 1350modules, unlike e.g. that in ghcilink004) and is built "dyn" way, then 1351it has it's code compiled and linked into the DLL, which GHCi linker picks 1352when loading the package's code (see the big comment in the beginning of 1353`locateLib`). 1354 1355When loading DLLs, GHCi linker simply calls the system's `dlopen` or 1356`LoadLibrary` APIs. This is quite different from the case when GHCi linker 1357loads an object file or static library. When loading an object file or static 1358library GHCi linker parses them and resolves all symbols "manually". 1359These object file or static library may reference some external symbols 1360defined in some external DLLs. And GHCi should know which these 1361external DLLs are. 1362 1363But when GHCi loads a DLL, it's the *system* linker who manages all 1364the necessary dependencies, and it is able to load this DLL not having 1365any extra info. Thus we don't *have to* crash in this case even if we 1366are unable to load any supposed dependencies explicitly. 1367 1368Suppose during GHCi session a client of the package wants to 1369`foreign import` a symbol which isn't exposed by the package DLL, but 1370is exposed by such an external (dependency) DLL. 1371If the DLL isn't *explicitly* loaded because `load_dyn` failed to do 1372this, then the client code eventually crashes because the GHCi linker 1373isn't able to locate this symbol (GHCi linker maintains a list of 1374explicitly loaded DLLs it looks into when trying to find a symbol). 1375 1376This is why we still should try to load all the dependency DLLs 1377even though we know that the system linker loads them implicitly when 1378loading the package DLL. 1379 1380Why we still keep the `crash_early` opportunity then not allowing such 1381a permissive behaviour for any DLLs? Well, we, perhaps, improve a user 1382experience in some cases slightly. 1383 1384But if it happens there exist other corner cases where our current 1385usage of `crash_early` flag is overly restrictive, we may lift the 1386restriction very easily. 1387-} 1388 1389-- we have already searched the filesystem; the strings passed to load_dyn 1390-- can be passed directly to loadDLL. They are either fully-qualified 1391-- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so"). In the latter case, 1392-- loadDLL is going to search the system paths to find the library. 1393load_dyn :: HscEnv -> Bool -> FilePath -> IO () 1394load_dyn hsc_env crash_early dll = do 1395 r <- loadDLL hsc_env dll 1396 case r of 1397 Nothing -> return () 1398 Just err -> 1399 if crash_early 1400 then cmdLineErrorIO err 1401 else let dflags = hsc_dflags hsc_env in 1402 when (wopt Opt_WarnMissedExtraSharedLib dflags) 1403 $ putLogMsg dflags 1404 (Reason Opt_WarnMissedExtraSharedLib) SevWarning 1405 noSrcSpan (defaultUserStyle dflags)(note err) 1406 where 1407 note err = vcat $ map text 1408 [ err 1409 , "It's OK if you don't want to use symbols from it directly." 1410 , "(the package DLL is loaded by the system linker" 1411 , " which manages dependencies by itself)." ] 1412 1413loadFrameworks :: HscEnv -> Platform -> PackageConfig -> IO () 1414loadFrameworks hsc_env platform pkg 1415 = when (platformUsesFrameworks platform) $ mapM_ load frameworks 1416 where 1417 fw_dirs = Packages.frameworkDirs pkg 1418 frameworks = Packages.frameworks pkg 1419 1420 load fw = do r <- loadFramework hsc_env fw_dirs fw 1421 case r of 1422 Nothing -> return () 1423 Just err -> cmdLineErrorIO ("can't load framework: " 1424 ++ fw ++ " (" ++ err ++ ")" ) 1425 1426-- Try to find an object file for a given library in the given paths. 1427-- If it isn't present, we assume that addDLL in the RTS can find it, 1428-- which generally means that it should be a dynamic library in the 1429-- standard system search path. 1430-- For GHCi we tend to prefer dynamic libraries over static ones as 1431-- they are easier to load and manage, have less overhead. 1432locateLib :: HscEnv -> Bool -> [FilePath] -> [FilePath] -> String 1433 -> IO LibrarySpec 1434locateLib hsc_env is_hs lib_dirs gcc_dirs lib 1435 | not is_hs 1436 -- For non-Haskell libraries (e.g. gmp, iconv): 1437 -- first look in library-dirs for a dynamic library (on User paths only) 1438 -- (libfoo.so) 1439 -- then try looking for import libraries on Windows (on User paths only) 1440 -- (.dll.a, .lib) 1441 -- first look in library-dirs for a dynamic library (on GCC paths only) 1442 -- (libfoo.so) 1443 -- then check for system dynamic libraries (e.g. kernel32.dll on windows) 1444 -- then try looking for import libraries on Windows (on GCC paths only) 1445 -- (.dll.a, .lib) 1446 -- then look in library-dirs for a static library (libfoo.a) 1447 -- then look in library-dirs and inplace GCC for a dynamic library (libfoo.so) 1448 -- then try looking for import libraries on Windows (.dll.a, .lib) 1449 -- then look in library-dirs and inplace GCC for a static library (libfoo.a) 1450 -- then try "gcc --print-file-name" to search gcc's search path 1451 -- for a dynamic library (#5289) 1452 -- otherwise, assume loadDLL can find it 1453 -- 1454 -- The logic is a bit complicated, but the rationale behind it is that 1455 -- loading a shared library for us is O(1) while loading an archive is 1456 -- O(n). Loading an import library is also O(n) so in general we prefer 1457 -- shared libraries because they are simpler and faster. 1458 -- 1459 = 1460#if defined(CAN_LOAD_DLL) 1461 findDll user `orElse` 1462#endif 1463 tryImpLib user `orElse` 1464#if defined(CAN_LOAD_DLL) 1465 findDll gcc `orElse` 1466 findSysDll `orElse` 1467#endif 1468 tryImpLib gcc `orElse` 1469 findArchive `orElse` 1470 tryGcc `orElse` 1471 assumeDll 1472 1473 | loading_dynamic_hs_libs -- search for .so libraries first. 1474 = findHSDll `orElse` 1475 findDynObject `orElse` 1476 assumeDll 1477 1478 | otherwise 1479 -- use HSfoo.{o,p_o} if it exists, otherwise fallback to libHSfoo{,_p}.a 1480 = findObject `orElse` 1481 findArchive `orElse` 1482 assumeDll 1483 1484 where 1485 dflags = hsc_dflags hsc_env 1486 dirs = lib_dirs ++ gcc_dirs 1487 gcc = False 1488 user = True 1489 1490 obj_file 1491 | is_hs && loading_profiled_hs_libs = lib <.> "p_o" 1492 | otherwise = lib <.> "o" 1493 dyn_obj_file = lib <.> "dyn_o" 1494 arch_files = [ "lib" ++ lib ++ lib_tag <.> "a" 1495 , lib <.> "a" -- native code has no lib_tag 1496 , "lib" ++ lib, lib 1497 ] 1498 lib_tag = if is_hs && loading_profiled_hs_libs then "_p" else "" 1499 1500 loading_profiled_hs_libs = interpreterProfiled dflags 1501 loading_dynamic_hs_libs = interpreterDynamic dflags 1502 1503 import_libs = [ lib <.> "lib" , "lib" ++ lib <.> "lib" 1504 , "lib" ++ lib <.> "dll.a", lib <.> "dll.a" 1505 ] 1506 1507 hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags 1508 hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name 1509 1510 so_name = mkSOName platform lib 1511 lib_so_name = "lib" ++ so_name 1512 dyn_lib_file = case (arch, os) of 1513 (ArchX86_64, OSSolaris2) -> "64" </> so_name 1514 _ -> so_name 1515 1516 findObject = liftM (fmap $ Objects . (:[])) $ findFile dirs obj_file 1517 findDynObject = liftM (fmap $ Objects . (:[])) $ findFile dirs dyn_obj_file 1518 findArchive = let local name = liftM (fmap Archive) $ findFile dirs name 1519 in apply (map local arch_files) 1520 findHSDll = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file 1521 findDll re = let dirs' = if re == user then lib_dirs else gcc_dirs 1522 in liftM (fmap DLLPath) $ findFile dirs' dyn_lib_file 1523 findSysDll = fmap (fmap $ DLL . dropExtension . takeFileName) $ 1524 findSystemLibrary hsc_env so_name 1525 tryGcc = let search = searchForLibUsingGcc dflags 1526 dllpath = liftM (fmap DLLPath) 1527 short = dllpath $ search so_name lib_dirs 1528 full = dllpath $ search lib_so_name lib_dirs 1529 gcc name = liftM (fmap Archive) $ search name lib_dirs 1530 files = import_libs ++ arch_files 1531 dlls = [short, full] 1532 archives = map gcc files 1533 in apply $ 1534#if defined(CAN_LOAD_DLL) 1535 dlls ++ 1536#endif 1537 archives 1538 tryImpLib re = case os of 1539 OSMinGW32 -> 1540 let dirs' = if re == user then lib_dirs else gcc_dirs 1541 implib name = liftM (fmap Archive) $ 1542 findFile dirs' name 1543 in apply (map implib import_libs) 1544 _ -> return Nothing 1545 1546 -- TH Makes use of the interpreter so this failure is not obvious. 1547 -- So we are nice and warn/inform users why we fail before we do. 1548 -- But only for haskell libraries, as C libraries don't have a 1549 -- profiling/non-profiling distinction to begin with. 1550 assumeDll 1551 | is_hs 1552 , not loading_dynamic_hs_libs 1553 , interpreterProfiled dflags 1554 = do 1555 warningMsg dflags 1556 (text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$ 1557 text " \tTrying dynamic library instead. If this fails try to rebuild" <+> 1558 text "libraries with profiling support.") 1559 return (DLL lib) 1560 | otherwise = return (DLL lib) 1561 infixr `orElse` 1562 f `orElse` g = f >>= maybe g return 1563 1564 apply :: [IO (Maybe a)] -> IO (Maybe a) 1565 apply [] = return Nothing 1566 apply (x:xs) = do x' <- x 1567 if isJust x' 1568 then return x' 1569 else apply xs 1570 1571 platform = targetPlatform dflags 1572 arch = platformArch platform 1573 os = platformOS platform 1574 1575searchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath) 1576searchForLibUsingGcc dflags so dirs = do 1577 -- GCC does not seem to extend the library search path (using -L) when using 1578 -- --print-file-name. So instead pass it a new base location. 1579 str <- askLd dflags (map (FileOption "-B") dirs 1580 ++ [Option "--print-file-name", Option so]) 1581 let file = case lines str of 1582 [] -> "" 1583 l:_ -> l 1584 if (file == so) 1585 then return Nothing 1586 else do b <- doesFileExist file -- file could be a folder (see #16063) 1587 return (if b then Just file else Nothing) 1588 1589-- | Retrieve the list of search directory GCC and the System use to find 1590-- libraries and components. See Note [Fork/Exec Windows]. 1591getGCCPaths :: DynFlags -> OS -> IO [FilePath] 1592getGCCPaths dflags os 1593 = case os of 1594 OSMinGW32 -> 1595 do gcc_dirs <- getGccSearchDirectory dflags "libraries" 1596 sys_dirs <- getSystemDirectories 1597 return $ nub $ gcc_dirs ++ sys_dirs 1598 _ -> return [] 1599 1600-- | Cache for the GCC search directories as this can't easily change 1601-- during an invocation of GHC. (Maybe with some env. variable but we'll) 1602-- deal with that highly unlikely scenario then. 1603{-# NOINLINE gccSearchDirCache #-} 1604gccSearchDirCache :: IORef [(String, [String])] 1605gccSearchDirCache = unsafePerformIO $ newIORef [] 1606 1607-- Note [Fork/Exec Windows] 1608-- ~~~~~~~~~~~~~~~~~~~~~~~~ 1609-- fork/exec is expensive on Windows, for each time we ask GCC for a library we 1610-- have to eat the cost of af least 3 of these: gcc -> real_gcc -> cc1. 1611-- So instead get a list of location that GCC would search and use findDirs 1612-- which hopefully is written in an optimized mannor to take advantage of 1613-- caching. At the very least we remove the overhead of the fork/exec and waits 1614-- which dominate a large percentage of startup time on Windows. 1615getGccSearchDirectory :: DynFlags -> String -> IO [FilePath] 1616getGccSearchDirectory dflags key = do 1617 cache <- readIORef gccSearchDirCache 1618 case lookup key cache of 1619 Just x -> return x 1620 Nothing -> do 1621 str <- askLd dflags [Option "--print-search-dirs"] 1622 let line = dropWhile isSpace str 1623 name = key ++ ": =" 1624 if null line 1625 then return [] 1626 else do let val = split $ find name line 1627 dirs <- filterM doesDirectoryExist val 1628 modifyIORef' gccSearchDirCache ((key, dirs):) 1629 return val 1630 where split :: FilePath -> [FilePath] 1631 split r = case break (==';') r of 1632 (s, [] ) -> [s] 1633 (s, (_:xs)) -> s : split xs 1634 1635 find :: String -> String -> String 1636 find r x = let lst = lines x 1637 val = filter (r `isPrefixOf`) lst 1638 in if null val 1639 then [] 1640 else case break (=='=') (head val) of 1641 (_ , []) -> [] 1642 (_, (_:xs)) -> xs 1643 1644-- | Get a list of system search directories, this to alleviate pressure on 1645-- the findSysDll function. 1646getSystemDirectories :: IO [FilePath] 1647#if defined(mingw32_HOST_OS) 1648getSystemDirectories = fmap (:[]) getSystemDirectory 1649#else 1650getSystemDirectories = return [] 1651#endif 1652 1653-- | Merge the given list of paths with those in the environment variable 1654-- given. If the variable does not exist then just return the identity. 1655addEnvPaths :: String -> [String] -> IO [String] 1656addEnvPaths name list 1657 = do -- According to POSIX (chapter 8.3) a zero-length prefix means current 1658 -- working directory. Replace empty strings in the env variable with 1659 -- `working_dir` (see also #14695). 1660 working_dir <- getCurrentDirectory 1661 values <- lookupEnv name 1662 case values of 1663 Nothing -> return list 1664 Just arr -> return $ list ++ splitEnv working_dir arr 1665 where 1666 splitEnv :: FilePath -> String -> [String] 1667 splitEnv working_dir value = 1668 case break (== envListSep) value of 1669 (x, [] ) -> 1670 [if null x then working_dir else x] 1671 (x, (_:xs)) -> 1672 (if null x then working_dir else x) : splitEnv working_dir xs 1673#if defined(mingw32_HOST_OS) 1674 envListSep = ';' 1675#else 1676 envListSep = ':' 1677#endif 1678 1679-- ---------------------------------------------------------------------------- 1680-- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32) 1681 1682{- 1683Note [macOS Big Sur dynamic libraries] 1684~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1685 1686macOS Big Sur makes the following change to how frameworks are shipped 1687with the OS: 1688 1689> New in macOS Big Sur 11 beta, the system ships with a built-in 1690> dynamic linker cache of all system-provided libraries. As part of 1691> this change, copies of dynamic libraries are no longer present on 1692> the filesystem. Code that attempts to check for dynamic library 1693> presence by looking for a file at a path or enumerating a directory 1694> will fail. Instead, check for library presence by attempting to 1695> dlopen() the path, which will correctly check for the library in the 1696> cache. (62986286) 1697 1698(https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/) 1699 1700Therefore, the previous method of checking whether a library exists 1701before attempting to load it makes GHC.Runtime.Linker.loadFramework 1702fail to find frameworks installed at /System/Library/Frameworks. 1703Instead, any attempt to load a framework at runtime, such as by 1704passing -framework OpenGL to runghc or running code loading such a 1705framework with GHCi, fails with a 'not found' message. 1706 1707GHC.Runtime.Linker.loadFramework now opportunistically loads the 1708framework libraries without checking for their existence first, 1709failing only if all attempts to load a given framework from any of the 1710various possible locations fail. See also #18446, which this change 1711addresses. 1712-} 1713 1714-- Darwin / MacOS X only: load a framework 1715-- a framework is a dynamic library packaged inside a directory of the same 1716-- name. They are searched for in different paths than normal libraries. 1717loadFramework :: HscEnv -> [FilePath] -> FilePath -> IO (Maybe String) 1718loadFramework hsc_env extraPaths rootname 1719 = do { either_dir <- tryIO getHomeDirectory 1720 ; let homeFrameworkPath = case either_dir of 1721 Left _ -> [] 1722 Right dir -> [dir </> "Library/Frameworks"] 1723 ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths 1724 ; errs <- findLoadDLL ps [] 1725 ; return $ fmap (intercalate ", ") errs 1726 } 1727 where 1728 fwk_file = rootname <.> "framework" </> rootname 1729 1730 -- sorry for the hardcoded paths, I hope they won't change anytime soon: 1731 defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"] 1732 1733 -- Try to call loadDLL for each candidate path. 1734 -- 1735 -- See Note [macOS Big Sur dynamic libraries] 1736 findLoadDLL [] errs = 1737 -- Tried all our known library paths, but dlopen() 1738 -- has no built-in paths for frameworks: give up 1739 return $ Just errs 1740 findLoadDLL (p:ps) errs = 1741 do { dll <- loadDLL hsc_env (p </> fwk_file) 1742 ; case dll of 1743 Nothing -> return Nothing 1744 Just err -> findLoadDLL ps ((p ++ ": " ++ err):errs) 1745 } 1746 1747{- ********************************************************************** 1748 1749 Helper functions 1750 1751 ********************************************************************* -} 1752 1753maybePutStr :: DynFlags -> String -> IO () 1754maybePutStr dflags s 1755 = when (verbosity dflags > 1) $ 1756 putLogMsg dflags 1757 NoReason 1758 SevInteractive 1759 noSrcSpan 1760 (defaultUserStyle dflags) 1761 (text s) 1762 1763maybePutStrLn :: DynFlags -> String -> IO () 1764maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n") 1765