X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=2f72dfd7dc0f62fdc6e59b648fdd364a4cff51d9;hb=1fe3295319c281cfe46a60a5e987a1f3a0316edc;hp=03baf659e99c5a2a723618b28fbc66397da57172;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 03baf65..2f72dfd 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -47,7 +47,7 @@ import Name import NameEnv import NameSet import qualified OccName -import UniqFM +import LazyUniqFM import Module import ListSetOps import DynFlags @@ -73,6 +73,7 @@ import Data.IORef import Data.List import Foreign +import System.FilePath import System.IO import System.Directory @@ -171,7 +172,7 @@ deleteFromLinkEnv to_remove dataConInfoPtrToName :: Ptr () -> TcM (Either String Name) dataConInfoPtrToName x = do - theString <- ioToTcRn $ do + theString <- liftIO $ do let ptr = castPtr x :: Ptr StgInfoTable conDescAddress <- getConDescAddress ptr peekArray0 0 conDescAddress @@ -537,9 +538,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 @@ -617,15 +618,15 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods 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 + 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 @@ -657,11 +658,11 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods return lnk adjust_ul osuf (DotO file) = do - let new_file = replaceFilenameSuffix file osuf + let new_file = replaceExtension file osuf 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} @@ -946,7 +947,7 @@ partOfGHCi # if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS) = [ ] # else - = [ "base", "haskell98", "template-haskell", "readline" ] + = [ "base", "haskell98", "template-haskell", "editline" ] # endif showLS (Object nm) = "(static) " ++ nm @@ -1080,8 +1081,8 @@ locateOneObj dirs lib Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion)) Nothing -> return (DLL lib) }} -- We assume where - mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o") - mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion) + mk_obj_path dir = dir lib <.> "o" + mk_dyn_lib_path dir = dir mkSOName (lib ++ "-ghc" ++ cProjectVersion) #else -- When the GHC package was compiled as dynamic library (=__PIC__ set), -- we search for .so libraries first. @@ -1096,8 +1097,8 @@ locateOneObj dirs lib Just obj_path -> return (Object obj_path) Nothing -> return (DLL lib) }} -- We assume where - mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o") - mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion) + mk_obj_path dir = dir (lib <.> "o") + mk_dyn_lib_path dir = dir mkSOName (lib ++ "-ghc" ++ cProjectVersion) #endif -- ---------------------------------------------------------------------------- @@ -1112,16 +1113,16 @@ loadDynamic paths rootname -- Tried all our known library paths, so let -- dlopen() search its own builtin paths now. where - mk_dll_path dir = dir `joinFileName` mkSOName rootname + mk_dll_path dir = dir mkSOName rootname #if defined(darwin_TARGET_OS) -mkSOName root = ("lib" ++ root) `joinFileExt` "dylib" +mkSOName root = ("lib" ++ root) <.> "dylib" #elif defined(mingw32_TARGET_OS) -- Win32 DLLs have no .dll extension here, because addDLL tries -- both foo.dll and foo.drv mkSOName root = root #else -mkSOName root = ("lib" ++ root) `joinFileExt` "so" +mkSOName root = ("lib" ++ root) <.> "so" #endif -- Darwin / MacOS X only: load a framework @@ -1129,15 +1130,20 @@ mkSOName root = ("lib" ++ root) `joinFileExt` "so" -- name. They are searched for in different paths than normal libraries. #ifdef darwin_TARGET_OS loadFramework extraPaths rootname - = do { mb_fwk <- findFile mk_fwk (extraPaths ++ defaultFrameworkPaths) - ; case mb_fwk of - Just fwk_path -> loadDLL fwk_path - Nothing -> return (Just "not found") } - -- Tried all our known library paths, but dlopen() - -- has no built-in paths for frameworks: give up + = do { either_dir <- Control.Exception.try getHomeDirectory + ; let homeFrameworkPath = case either_dir of + Left _ -> [] + Right dir -> [dir ++ "/Library/Frameworks"] + ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths + ; mb_fwk <- findFile mk_fwk ps + ; case mb_fwk of + Just fwk_path -> loadDLL fwk_path + Nothing -> return (Just "not found") } + -- Tried all our known library paths, but dlopen() + -- has no built-in paths for frameworks: give up where - mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname) - -- sorry for the hardcoded paths, I hope they won't change anytime soon: + mk_fwk dir = dir (rootname ++ ".framework/" ++ rootname) + -- sorry for the hardcoded paths, I hope they won't change anytime soon: defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"] #endif \end{code}