Fix #5289 (loading libstdc++.so in GHCi), and also fix some other

linking scenarios.  We weren't searching for .a archives to satisfy
-lfoo options on the GHCi command line, for example.

I've tidied up the code in this module so that dealing with -l options
on the command line is consistent with the handling of extra-libraries
for packages.

While I was here I moved some stuff out of Linker.hs that didn't seem
to belong here: dataConInfoPtrToName (now in new module DebuggerUtils)
and lessUnsafeCoerce (now in DynamicLoading, next to its only use)

1 files changed, 129 insertions, 0 deletions

diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs
new file mode 100644
index 0000000000..f357b97669
--- /dev/null
+++ b/compiler/ghci/DebuggerUtils.hs
@@ -0,0 +1,129 @@
+module DebuggerUtils (
+       dataConInfoPtrToName,
+  ) where
+
+import ByteCodeItbls
+import FastString
+import TcRnTypes
+import TcRnMonad
+import IfaceEnv
+import CgInfoTbls
+import SMRep
+import Module
+import OccName
+import Name
+import Outputable
+import Constants
+import MonadUtils ()
+import Util
+
+import Data.Char
+import Foreign
+import Data.List
+
+#include "HsVersions.h"
+
+-- | Given a data constructor in the heap, find its Name.
+--   The info tables for data constructors have a field which records
+--   the source name of the constructor as a Ptr Word8 (UTF-8 encoded
+--   string). The format is:
+--
+--   > Package:Module.Name
+--
+--   We use this string to lookup the interpreter's internal representation of the name
+--   using the lookupOrig.    
+--
+dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
+dataConInfoPtrToName x = do 
+   theString <- liftIO $ do
+      let ptr = castPtr x :: Ptr StgInfoTable
+      conDescAddress <- getConDescAddress ptr 
+      peekArray0 0 conDescAddress  
+   let (pkg, mod, occ) = parse theString 
+       pkgFS = mkFastStringByteList pkg
+       modFS = mkFastStringByteList mod
+       occFS = mkFastStringByteList occ
+       occName = mkOccNameFS OccName.dataName occFS
+       modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS) 
+   return (Left$ showSDoc$ ppr modName <> dot <> ppr occName ) 
+    `recoverM` (Right `fmap` lookupOrig modName occName)
+
+   where
+
+   {- To find the string in the constructor's info table we need to consider 
+      the layout of info tables relative to the entry code for a closure.
+
+      An info table can be next to the entry code for the closure, or it can
+      be separate. The former (faster) is used in registerised versions of ghc, 
+      and the latter (portable) is for non-registerised versions. 
+
+      The diagrams below show where the string is to be found relative to 
+      the normal info table of the closure.
+
+      1) Code next to table:
+
+         --------------
+         |            |   <- pointer to the start of the string
+         --------------
+         |            |   <- the (start of the) info table structure
+         |            |
+         |            |
+         --------------
+         | entry code | 
+         |    ....    |
+
+         In this case the pointer to the start of the string can be found in
+         the memory location _one word before_ the first entry in the normal info 
+         table.
+
+      2) Code NOT next to table:
+
+                                 --------------
+         info table structure -> |     *------------------> --------------
+                                 |            |             | entry code |
+                                 |            |             |    ....    | 
+                                 --------------
+         ptr to start of str ->  |            |   
+                                 --------------
+
+         In this case the pointer to the start of the string can be found
+         in the memory location: info_table_ptr + info_table_size
+   -}
+
+   getConDescAddress :: Ptr StgInfoTable -> IO (Ptr Word8)
+   getConDescAddress ptr
+    | ghciTablesNextToCode = do
+       offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
+       return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord))
+    | otherwise =
+       peek $ intPtrToPtr $ (ptrToIntPtr ptr) + fromIntegral stdInfoTableSizeB
+
+   -- parsing names is a little bit fiddly because we have a string in the form: 
+   -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
+   -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
+   -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
+   -- this is not the conventional way of writing Haskell names. We stick with
+   -- convention, even though it makes the parsing code more troublesome.
+   -- Warning: this code assumes that the string is well formed.
+   parse :: [Word8] -> ([Word8], [Word8], [Word8])
+   parse input 
+      = ASSERT (all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
+      where
+      dot = fromIntegral (ord '.')
+      (pkg, rest1) = break (== fromIntegral (ord ':')) input 
+      (mod, occ) 
+         = (concat $ intersperse [dot] $ reverse modWords, occWord)
+         where
+         (modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
+      parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
+      -- We only look for dots if str could start with a module name,
+      -- i.e. if it starts with an upper case character.
+      -- Otherwise we might think that "X.:->" is the module name in
+      -- "X.:->.+", whereas actually "X" is the module name and
+      -- ":->.+" is a constructor name.
+      parseModOcc acc str@(c : _)
+       | isUpper $ chr $ fromIntegral c
+         = case break (== dot) str of
+              (top, []) -> (acc, top)
+              (top, _ : bot) -> parseModOcc (top : acc) bot
+      parseModOcc acc str = (acc, str)