X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FLinker.lhs;h=4ee87cde92dfd38146f8bee89f337d542d2e9776;hb=19519dc35bad5649226a9f7015eaabb154722e54;hp=f897eecb1505baef3ca80879b4d0a7ee5addf1d5;hpb=4f457f34795745c1fad5847d1983887e7666a6b7;p=ghc-hetmet.git diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index f897eec..4ee87cd 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/ghc/compiler/ghci/Linker.lhs @@ -1,5 +1,5 @@ % -% (c) The University of Glasgow 2000 +% (c) The University of Glasgow 2005 % -- -------------------------------------- @@ -20,7 +20,6 @@ module Linker ( HValue, showLinkerState, linkPackages, ) where -#include "../includes/ghcconfig.h" #include "HsVersions.h" import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker ) @@ -29,24 +28,21 @@ import ByteCodeItbls ( ItblEnv ) import ByteCodeAsm ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..)) import Packages -import DriverState ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts ) import DriverPhases ( isObjectFilename, isDynLibFilename ) -import DriverUtil ( getFileSuffix ) -#ifdef darwin_TARGET_OS -import DriverState ( v_Cmdline_frameworks, v_Framework_paths ) -#endif -import Finder ( findModule, findLinkable, FindResult(..) ) +import Util ( getFileSuffix ) +import Finder ( findModule, findObjectLinkableMaybe, FindResult(..) ) import HscTypes import Name ( Name, nameModule, isExternalName, isWiredInName ) import NameEnv import NameSet ( nameSetToList ) import Module import ListSetOps ( minusList ) -import CmdLineOpts ( DynFlags(..) ) +import DynFlags ( DynFlags(..), getOpts ) import BasicTypes ( SuccessFlag(..), succeeded, failed ) import Outputable import Panic ( GhcException(..) ) import Util ( zipLazy, global ) +import StaticFlags ( v_Ld_inputs ) -- Standard libraries import Control.Monad ( when, filterM, foldM ) @@ -58,6 +54,7 @@ import System.IO ( putStr, putStrLn, hPutStrLn, stderr, fixIO ) import System.Directory ( doesFileExist ) import Control.Exception ( block, throwDyn ) +import Maybe ( isJust, fromJust ) #if __GLASGOW_HASKELL__ >= 503 import GHC.IOBase ( IO(..) ) @@ -122,9 +119,8 @@ emptyPLS dflags = PersistentLinkerState { -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. where init_pkgs - | Just rts_id <- rtsPackageId (pkgState dflags) = [rts_id] + | ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id] | otherwise = [] - \end{code} \begin{code} @@ -208,11 +204,11 @@ reallyInitDynLinker dflags ; linkPackages dflags (explicitPackages (pkgState dflags)) -- (c) Link libraries from the command-line - ; opt_l <- getStaticOpts v_Opt_l - ; let minus_ls = [ lib | '-':'l':lib <- opt_l ] + ; let optl = getOpts dflags opt_l + ; let minus_ls = [ lib | '-':'l':lib <- optl ] -- (d) Link .o files from the command-line - ; lib_paths <- readIORef v_Library_paths + ; let lib_paths = libraryPaths dflags ; cmdline_ld_inputs <- readIORef v_Ld_inputs ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs @@ -320,7 +316,7 @@ linkExpr hsc_env root_ul_bco -- Find what packages and linkables are required ; eps <- readIORef (hsc_EPS hsc_env) - ; (lnks, pkgs) <- getLinkDeps dflags hpt (eps_PIT eps) needed_mods + ; (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps) needed_mods -- Link the packages and modules required ; linkPackages dflags pkgs @@ -355,12 +351,12 @@ linkExpr hsc_env root_ul_bco dieWith msg = throwDyn (ProgramError (showSDoc msg)) -getLinkDeps :: DynFlags -> HomePackageTable -> PackageIfaceTable +getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable -> [Module] -- If you need these -> IO ([Linkable], [PackageId]) -- ... then link these first -- Fails with an IO exception if it can't find enough files -getLinkDeps dflags hpt pit mods +getLinkDeps hsc_env hpt pit mods -- Find all the packages and linkables that a set of modules depends on = do { pls <- readIORef v_PersistentLinkerState ; let { @@ -386,7 +382,7 @@ getLinkDeps dflags hpt pit mods -- Get the things needed for the specified module -- This is rather similar to the code in RnNames.importsFromImportDecl get_deps mod - | ExternalPackage p <- mi_package iface + | ExtPackage p <- mi_package iface = ([], p : dep_pkgs deps) | otherwise = (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps) @@ -405,11 +401,12 @@ getLinkDeps dflags hpt pit mods get_linkable mod_name -- A home-package module | Just mod_info <- lookupModuleEnv hpt mod_name - = return (hm_linkable mod_info) + = ASSERT(isJust (hm_linkable mod_info)) + return (fromJust (hm_linkable mod_info)) | otherwise = -- It's not in the HPT because we are in one shot mode, -- so use the Finder to get a ModLocation... - do { mb_stuff <- findModule dflags mod_name False ; + do { mb_stuff <- findModule hsc_env mod_name False ; case mb_stuff of { Found loc _ -> found loc mod_name ; _ -> no_obj mod_name @@ -417,7 +414,7 @@ getLinkDeps dflags hpt pit mods found loc mod_name = do { -- ...and then find the linkable for it - mb_lnk <- findLinkable mod_name loc ; + mb_lnk <- findObjectLinkableMaybe mod_name loc ; case mb_lnk of { Nothing -> no_obj mod_name ; Just lnk -> return lnk @@ -762,7 +759,7 @@ linkPackage dflags pkg = do let dirs = Packages.libraryDirs pkg let libs = Packages.hsLibraries pkg ++ Packages.extraLibraries pkg - ++ [ lib | '-':'l':lib <- Packages.extraLdOpts pkg ] + ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ] classifieds <- mapM (locateOneObj dirs) libs -- Complication: all the .so's must be loaded before any of the .o's. @@ -806,7 +803,7 @@ loadFrameworks pkg = return () loadFrameworks pkg = mapM_ load frameworks where fw_dirs = Packages.frameworkDirs pkg - frameworks = Packages.extraFrameworks pkg + frameworks = Packages.frameworks pkg load fw = do r <- loadFramework fw_dirs fw case r of