X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=70af5f26e868d670e0a568c5fc94e415a3ec0af6;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=fe009c2fefba77ed3ee38ec3950401c281182fca;hpb=37f22a833c33c3ab504778fd91a39d8d48fa3766;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index fe009c2..70af5f2 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -56,6 +56,7 @@ import SrcLoc
 import UniqSet
 import Constants
 import FastString
+import Config		( cProjectVersion )
 
 -- Standard libraries
 import Control.Monad
@@ -161,7 +162,7 @@ deleteFromLinkEnv to_remove
 --   We use this string to lookup the interpreter's internal representation of the name
 --   using the lookupOrig.    
 
-dataConInfoPtrToName :: Ptr () -> TcM Name
+dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
 dataConInfoPtrToName x = do 
    theString <- ioToTcRn $ do
       let ptr = castPtr x :: Ptr StgInfoTable
@@ -173,7 +174,8 @@ dataConInfoPtrToName x = do
        occFS = mkFastStringByteList occ
        occName = mkOccNameFS OccName.dataName occFS
        modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS) 
-   lookupOrig modName occName
+   return (Left$ showSDoc$ ppr modName <> dot <> ppr occName ) 
+    `recoverM` (Right `fmap` lookupOrig modName occName)
 
    where
 
@@ -278,17 +280,31 @@ linkDependencies hsc_env span needed_mods = do
    linkModules dflags lnks
 
 
+-- | Temporarily extend the linker state.
+
 withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
 withExtendedLinkEnv new_env action
     = bracket set_new_env
               reset_old_env
               (const action)
-    where set_new_env = do pls <- readIORef v_PersistentLinkerState
-                           let new_closure_env = extendClosureEnv (closure_env pls) new_env
-                               new_pls = pls { closure_env = new_closure_env }
-                           writeIORef v_PersistentLinkerState new_pls
-                           return (closure_env pls)
-          reset_old_env env = modifyIORef v_PersistentLinkerState (\pls -> pls{ closure_env = env })
+    where set_new_env = do 
+            pls <- readIORef v_PersistentLinkerState
+            let new_closure_env = extendClosureEnv (closure_env pls) new_env
+                new_pls = pls { closure_env = new_closure_env }
+            writeIORef v_PersistentLinkerState new_pls
+            return (closure_env pls)
+
+        -- Remember that the linker state might be side-effected
+        -- during the execution of the IO action, and we don't want to
+        -- lose those changes (we might have linked a new module or
+        -- package), so the reset action only removes the names we
+        -- added earlier.
+          reset_old_env env = do
+            modifyIORef v_PersistentLinkerState $ \pls ->
+                let cur = closure_env pls
+                    new = delListFromNameEnv cur (map fst new_env)
+                in
+                pls{ closure_env = new }
 
 -- filterNameMap removes from the environment all entries except 
 -- 	those for a given set of modules;
@@ -1043,6 +1059,9 @@ loadFrameworks pkg = mapM_ load frameworks
 
 -- Try to find an object file for a given library in the given paths.
 -- If it isn't present, we assume it's a dynamic library.
+#ifndef __PIC__
+-- When the GHC package was not compiled as dynamic library (=__PIC__ not set),
+-- we search for .o libraries first.
 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
 locateOneObj dirs lib
   = do	{ mb_obj_path <- findFile mk_obj_path dirs 
@@ -1051,12 +1070,28 @@ locateOneObj dirs lib
 	    Nothing	  -> 
                 do { mb_lib_path <- findFile mk_dyn_lib_path dirs
                    ; case mb_lib_path of
-                       Just lib_path -> return (DLL (lib ++ "_dyn"))
+                       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 ++ "_dyn")
-
+     mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "-ghc" ++ cProjectVersion)
+#else
+-- When the GHC package was compiled as dynamic library (=__PIC__ set),
+-- we search for .so libraries first.
+locateOneObj :: [FilePath] -> String -> IO LibrarySpec
+locateOneObj dirs lib
+  = do	{ mb_lib_path <- findFile mk_dyn_lib_path dirs
+	; case mb_lib_path of
+	    Just lib_path -> return (DLL (lib ++ "-ghc" ++ cProjectVersion))
+	    Nothing	  ->
+                do { mb_obj_path <- findFile mk_obj_path dirs
+                   ; case mb_obj_path of
+                       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)
+#endif
 
 -- ----------------------------------------------------------------------------
 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)