X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=804d6c097afd9d63c95cab5325545a40c697cc63;hb=9181d6e98088505d25703b6fbd753b449ca8e5a8;hp=892171c1edf5136942457c4915cc1991434e514b;hpb=d51f42f602bf9a6d1b356c41228a534c88723f65;p=ghc-hetmet.git diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 892171c..804d6c0 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -31,6 +31,7 @@ module Linker ( HValue, getHValue, showLinkerState, #include "HsVersions.h" +import LoadIface import ObjLink import ByteCodeLink import ByteCodeItbls @@ -60,6 +61,7 @@ import StaticFlags import ErrUtils import DriverPhases import SrcLoc +import qualified Maybes import UniqSet import Constants import FastString @@ -395,13 +397,12 @@ reallyInitDynLinker dflags ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs -- (e) Link any MacOS frameworks -#ifdef darwin_TARGET_OS - ; let framework_paths = frameworkPaths dflags - ; let frameworks = cmdlineFrameworks dflags -#else - ; let frameworks = [] - ; let framework_paths = [] -#endif + ; let framework_paths + | isDarwinTarget = frameworkPaths dflags + | otherwise = [] + ; let frameworks + | isDarwinTarget = cmdlineFrameworks dflags + | otherwise = [] -- Finally do (c),(d),(e) ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ] ++ map DLL minus_ls @@ -538,9 +539,9 @@ checkNonStdWay dflags srcspan = do else return (Just default_osuf) failNonStd srcspan = dieWith srcspan $ - ptext SLIT("Dynamic linking required, but this is a non-standard build (eg. prof).") $$ - ptext SLIT("You need to build the program twice: once the normal way, and then") $$ - ptext SLIT("in the desired way using -osuf to set the object file suffix.") + ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$ + ptext (sLit "You need to build the program twice: once the normal way, and then") $$ + ptext (sLit "in the desired way using -osuf to set the object file suffix.") getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable @@ -553,10 +554,10 @@ getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods -- Find all the packages and linkables that a set of modules depends on = do { pls <- readIORef v_PersistentLinkerState ; - let { -- 1. Find the dependent home-pkg-modules/packages from each iface - (mods_s, pkgs_s) = follow_deps mods emptyUniqSet emptyUniqSet; + (mods_s, pkgs_s) <- follow_deps mods emptyUniqSet emptyUniqSet; + let { -- 2. Exclude ones already linked -- Main reason: avoid findModule calls in get_linkable mods_needed = mods_s `minusList` linked_mods ; @@ -585,29 +586,39 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods follow_deps :: [Module] -- modules to follow -> UniqSet ModuleName -- accum. module dependencies -> UniqSet PackageId -- accum. package dependencies - -> ([ModuleName], [PackageId]) -- result + -> IO ([ModuleName], [PackageId]) -- result follow_deps [] acc_mods acc_pkgs - = (uniqSetToList acc_mods, uniqSetToList acc_pkgs) + = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs - | pkg /= this_pkg - = follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg) - | mi_boot iface - = link_boot_mod_error mod - | otherwise - = follow_deps (map (mkModule this_pkg) boot_deps' ++ mods) acc_mods' acc_pkgs' - where - pkg = modulePackageId mod - iface = get_iface mod - deps = mi_deps iface - - pkg_deps = dep_pkgs deps - (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps) - where is_boot (m,True) = Left m - is_boot (m,False) = Right m - - boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps - acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps) - acc_pkgs' = addListToUniqSet acc_pkgs pkg_deps + = do + mb_iface <- initIfaceCheck hsc_env $ + loadInterface msg mod (ImportByUser False) + iface <- case mb_iface of + Maybes.Failed err -> ghcError (ProgramError (showSDoc err)) + Maybes.Succeeded iface -> return iface + + when (mi_boot iface) $ link_boot_mod_error mod + + let + pkg = modulePackageId mod + deps = mi_deps iface + + pkg_deps = dep_pkgs deps + (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps) + where is_boot (m,True) = Left m + is_boot (m,False) = Right m + + boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps + acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps) + acc_pkgs' = addListToUniqSet acc_pkgs pkg_deps + -- + if pkg /= this_pkg + then follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg) + else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods) + acc_mods' acc_pkgs' + where + msg = text "need to link module" <+> ppr mod <+> + text "due to use of Template Haskell" link_boot_mod_error mod = @@ -615,18 +626,12 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods text "module" <+> ppr mod <+> text "cannot be linked; it is only available as a boot module"))) - get_iface mod = case lookupIfaceByModule dflags hpt pit mod of - Just iface -> iface - Nothing -> pprPanic "getLinkDeps" (no_iface mod) - no_iface mod = ptext SLIT("No iface for") <+> ppr mod - -- This one is a GHC bug - no_obj mod = dieWith span $ - ptext SLIT("cannot find object file for module ") <> + ptext (sLit "cannot find object file for module ") <> quotes (ppr mod) $$ while_linking_expr - while_linking_expr = ptext SLIT("while linking an interpreted expression") + while_linking_expr = ptext (sLit "while linking an interpreted expression") -- This one is a build-system bug @@ -662,7 +667,7 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods ok <- doesFileExist new_file if (not ok) then dieWith span $ - ptext SLIT("cannot find normal object file ") + ptext (sLit "cannot find normal object file ") <> quotes (text new_file) $$ while_linking_expr else return (DotO new_file) \end{code} @@ -944,11 +949,8 @@ data LibrarySpec -- used by lookupSymbol. So we must call addDLL for each library -- just to get the DLL handle into the list. partOfGHCi -# if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS) - = [ ] -# else - = [ "base", "haskell98", "template-haskell", "readline" ] -# endif + | isWindowsTarget || isDarwinTarget = [] + | otherwise = [ "base", "haskell98", "template-haskell", "editline" ] showLS (Object nm) = "(static) " ++ nm showLS (DLL nm) = "(dynamic) " ++ nm @@ -1019,7 +1021,7 @@ linkPackage dflags pkg let dlls = [ dll | DLL dll <- classifieds ] objs = [ obj | Object obj <- classifieds ] - maybePutStr dflags ("Loading package " ++ showPackageId (package pkg) ++ " ... ") + maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ") -- See comments with partOfGHCi when (pkgName (package pkg) `notElem` partOfGHCi) $ do @@ -1043,7 +1045,7 @@ linkPackage dflags pkg maybePutStr dflags "linking ... " ok <- resolveObjs if succeeded ok then maybePutStrLn dflags "done." - else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'")) + else throwDyn (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'")) load_dyn dirs dll = do r <- loadDynamic dirs dll case r of