Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules

[ghc-hetmet.git] / compiler / ghci / Linker.lhs

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index fe009c2..6f000c5 100644 (file)
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -14,6 +14,13 @@ necessary.
 \begin{code}
 {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
 
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 module Linker ( HValue, getHValue, showLinkerState,
                linkExpr, unload, withExtendedLinkEnv,
                 extendLinkEnv, deleteFromLinkEnv,
@@ -56,6 +63,7 @@ import SrcLoc
 import UniqSet
 import Constants
 import FastString
+import Config          ( cProjectVersion )
 
 -- Standard libraries
 import Control.Monad
@@ -161,7 +169,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 +181,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 +287,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 +1066,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 +1077,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)