projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Minor refactoring in RtClosureInspect
[ghc-hetmet.git]
/
compiler
/
ghci
/
Linker.lhs
diff --git
a/compiler/ghci/Linker.lhs
b/compiler/ghci/Linker.lhs
index
d7f3da3
..
9fd39ef
100644
(file)
--- a/
compiler/ghci/Linker.lhs
+++ b/
compiler/ghci/Linker.lhs
@@
-14,6
+14,9
@@
necessary.
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
module Linker ( HValue, getHValue, showLinkerState,
linkExpr, unload, withExtendedLinkEnv,
extendLinkEnv, deleteFromLinkEnv,
module Linker ( HValue, getHValue, showLinkerState,
linkExpr, unload, withExtendedLinkEnv,
extendLinkEnv, deleteFromLinkEnv,
@@
-72,7
+75,9
@@
import System.FilePath
import System.IO
import System.Directory
import System.IO
import System.Directory
-import Control.Exception
+import Distribution.Package hiding (depends)
+
+import Exception
import Data.Maybe
\end{code}
import Data.Maybe
\end{code}
@@
-258,7
+263,7
@@
getHValue :: HscEnv -> Name -> IO HValue
getHValue hsc_env name = do
when (isExternalName name) $ do
ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
getHValue hsc_env name = do
when (isExternalName name) $ do
ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
- when (failed ok) $ throwDyn (ProgramError "")
+ when (failed ok) $ ghcError (ProgramError "")
pls <- readIORef v_PersistentLinkerState
lookupName (closure_env pls) name
pls <- readIORef v_PersistentLinkerState
lookupName (closure_env pls) name
@@
-408,7
+413,7
@@
reallyInitDynLinker dflags
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done"
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done"
- else throwDyn (InstallationError "linking extra libraries/objects failed")
+ else ghcError (InstallationError "linking extra libraries/objects failed")
}}
classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
}}
classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
@@
-464,7
+469,7
@@
preloadLib dflags lib_paths framework_paths lib_spec
if not b then return False
else loadObj name >> return True
if not b then return False
else loadObj name >> return True
- give_up = throwDyn $
+ give_up = ghcError $
CmdLineError "user specified .o/.so/.DLL could not be loaded."
\end{code}
CmdLineError "user specified .o/.so/.DLL could not be loaded."
\end{code}
@@
-495,7
+500,7
@@
linkExpr hsc_env span root_ul_bco
-- Link the packages and modules required
; ok <- linkDependencies hsc_env span needed_mods
; if failed ok then
-- Link the packages and modules required
; ok <- linkDependencies hsc_env span needed_mods
; if failed ok then
- throwDyn (ProgramError "")
+ ghcError (ProgramError "")
else do {
-- Link the expression itself
else do {
-- Link the expression itself
@@
-521,7
+526,7
@@
linkExpr hsc_env span root_ul_bco
-- by default, so we can safely ignore them here.
dieWith :: SrcSpan -> Message -> IO a
-- by default, so we can safely ignore them here.
dieWith :: SrcSpan -> Message -> IO a
-dieWith span msg = throwDyn (ProgramError (showSDoc (mkLocMessage span msg)))
+dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
@@
-618,7
+623,7
@@
getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
link_boot_mod_error mod =
link_boot_mod_error mod =
- throwDyn (ProgramError (showSDoc (
+ ghcError (ProgramError (showSDoc (
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
@@
-944,10
+949,11
@@
data LibrarySpec
-- of DLL handles that rts/Linker.c maintains, and that in turn is
-- used by lookupSymbol. So we must call addDLL for each library
-- just to get the DLL handle into the list.
-- of DLL handles that rts/Linker.c maintains, and that in turn is
-- used by lookupSymbol. So we must call addDLL for each library
-- just to get the DLL handle into the list.
-partOfGHCi :: [String]
+partOfGHCi :: [PackageName]
partOfGHCi
| isWindowsTarget || isDarwinTarget = []
partOfGHCi
| isWindowsTarget || isDarwinTarget = []
- | otherwise = [ "base", "haskell98", "template-haskell", "editline" ]
+ | otherwise = map PackageName
+ ["base", "haskell98", "template-haskell", "editline"]
showLS :: LibrarySpec -> String
showLS (Object nm) = "(static) " ++ nm
showLS :: LibrarySpec -> String
showLS (Object nm) = "(static) " ++ nm
@@
-993,7
+999,7
@@
linkPackages dflags new_pkgs
; return (new_pkg : pkgs') }
| otherwise
; return (new_pkg : pkgs') }
| otherwise
- = throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+ = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
linkPackage :: DynFlags -> PackageConfig -> IO ()
linkPackage :: DynFlags -> PackageConfig -> IO ()
@@
-1022,7
+1028,7
@@
linkPackage dflags pkg
maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
-- See comments with partOfGHCi
maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
-- See comments with partOfGHCi
- when (pkgName (package pkg) `notElem` partOfGHCi) $ do
+ when (packageName pkg `notElem` partOfGHCi) $ do
loadFrameworks pkg
-- When a library A needs symbols from a library B, the order in
-- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
loadFrameworks pkg
-- When a library A needs symbols from a library B, the order in
-- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
@@
-1043,13
+1049,13
@@
linkPackage dflags pkg
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
- else throwDyn (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
+ else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
load_dyn :: [FilePath] -> FilePath -> IO ()
load_dyn dirs dll = do r <- loadDynamic dirs dll
case r of
Nothing -> return ()
load_dyn :: [FilePath] -> FilePath -> IO ()
load_dyn dirs dll = do r <- loadDynamic dirs dll
case r of
Nothing -> return ()
- Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: "
+ Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
++ dll ++ " (" ++ err ++ ")" ))
loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
++ dll ++ " (" ++ err ++ ")" ))
loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
@@
-1063,7
+1069,7
@@
loadFrameworks pkg
load fw = do r <- loadFramework fw_dirs fw
case r of
Nothing -> return ()
load fw = do r <- loadFramework fw_dirs fw
case r of
Nothing -> return ()
- Just err -> throwDyn (CmdLineError ("can't load framework: "
+ Just err -> ghcError (CmdLineError ("can't load framework: "
++ fw ++ " (" ++ err ++ ")" ))
-- Try to find an object file for a given library in the given paths.
++ fw ++ " (" ++ err ++ ")" ))
-- Try to find an object file for a given library in the given paths.
@@
-1079,7
+1085,7
@@
locateOneObj dirs lib
Nothing ->
do { mb_lib_path <- findFile mk_dyn_lib_path dirs
; case mb_lib_path of
Nothing ->
do { mb_lib_path <- findFile mk_dyn_lib_path dirs
; case mb_lib_path of
- Just _ -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
+ Just _ -> return (DLL dyn_lib_name)
Nothing -> return (DLL lib) }} -- We assume
| otherwise
-- When the GHC package was compiled as dynamic library (=__PIC__ set),
Nothing -> return (DLL lib) }} -- We assume
| otherwise
-- When the GHC package was compiled as dynamic library (=__PIC__ set),
@@
-1094,7
+1100,8
@@
locateOneObj dirs lib
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir </> (lib <.> "o")
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir </> (lib <.> "o")
- mk_dyn_lib_path dir = dir </> mkSOName (lib ++ "-ghc" ++ cProjectVersion)
+ dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
+ mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
-- ----------------------------------------------------------------------------
-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
-- ----------------------------------------------------------------------------
-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
@@
-1124,7
+1131,7
@@
mkSOName root
-- name. They are searched for in different paths than normal libraries.
loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
loadFramework extraPaths rootname
-- name. They are searched for in different paths than normal libraries.
loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
loadFramework extraPaths rootname
- = do { either_dir <- Control.Exception.try getHomeDirectory
+ = do { either_dir <- tryIO getHomeDirectory
; let homeFrameworkPath = case either_dir of
Left _ -> []
Right dir -> [dir ++ "/Library/Frameworks"]
; let homeFrameworkPath = case either_dir of
Left _ -> []
Right dir -> [dir ++ "/Library/Frameworks"]