Don't duplicate arbitrary CmmCalls
[ghc.git] / compiler / ghci / DebuggerUtils.hs
1 module DebuggerUtils (
2 dataConInfoPtrToName,
3 ) where
4
5 import ByteCodeItbls
6 import DynFlags
7 import FastString
8 import TcRnTypes
9 import TcRnMonad
10 import IfaceEnv
11 import CgInfoTbls
12 import SMRep
13 import Module
14 import OccName
15 import Name
16 import Outputable
17 import Constants
18 import MonadUtils ()
19 import Util
20
21 import Data.Char
22 import Foreign
23 import Data.List
24
25 #include "HsVersions.h"
26
27 -- | Given a data constructor in the heap, find its Name.
28 -- The info tables for data constructors have a field which records
29 -- the source name of the constructor as a Ptr Word8 (UTF-8 encoded
30 -- string). The format is:
31 --
32 -- > Package:Module.Name
33 --
34 -- We use this string to lookup the interpreter's internal representation of the name
35 -- using the lookupOrig.
36 --
37 dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
38 dataConInfoPtrToName x = do
39 theString <- liftIO $ do
40 let ptr = castPtr x :: Ptr StgInfoTable
41 conDescAddress <- getConDescAddress ptr
42 peekArray0 0 conDescAddress
43 let (pkg, mod, occ) = parse theString
44 pkgFS = mkFastStringByteList pkg
45 modFS = mkFastStringByteList mod
46 occFS = mkFastStringByteList occ
47 occName = mkOccNameFS OccName.dataName occFS
48 modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS)
49 dflags <- getDynFlags
50 return (Left $ showSDoc dflags $ ppr modName <> dot <> ppr occName)
51 `recoverM` (Right `fmap` lookupOrig modName occName)
52
53 where
54
55 {- To find the string in the constructor's info table we need to consider
56 the layout of info tables relative to the entry code for a closure.
57
58 An info table can be next to the entry code for the closure, or it can
59 be separate. The former (faster) is used in registerised versions of ghc,
60 and the latter (portable) is for non-registerised versions.
61
62 The diagrams below show where the string is to be found relative to
63 the normal info table of the closure.
64
65 1) Code next to table:
66
67 --------------
68 | | <- pointer to the start of the string
69 --------------
70 | | <- the (start of the) info table structure
71 | |
72 | |
73 --------------
74 | entry code |
75 | .... |
76
77 In this case the pointer to the start of the string can be found in
78 the memory location _one word before_ the first entry in the normal info
79 table.
80
81 2) Code NOT next to table:
82
83 --------------
84 info table structure -> | *------------------> --------------
85 | | | entry code |
86 | | | .... |
87 --------------
88 ptr to start of str -> | |
89 --------------
90
91 In this case the pointer to the start of the string can be found
92 in the memory location: info_table_ptr + info_table_size
93 -}
94
95 getConDescAddress :: Ptr StgInfoTable -> IO (Ptr Word8)
96 getConDescAddress ptr
97 | ghciTablesNextToCode = do
98 offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
99 return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord))
100 | otherwise =
101 peek $ intPtrToPtr $ (ptrToIntPtr ptr) + fromIntegral stdInfoTableSizeB
102
103 -- parsing names is a little bit fiddly because we have a string in the form:
104 -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
105 -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
106 -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
107 -- this is not the conventional way of writing Haskell names. We stick with
108 -- convention, even though it makes the parsing code more troublesome.
109 -- Warning: this code assumes that the string is well formed.
110 parse :: [Word8] -> ([Word8], [Word8], [Word8])
111 parse input
112 = ASSERT (all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
113 where
114 dot = fromIntegral (ord '.')
115 (pkg, rest1) = break (== fromIntegral (ord ':')) input
116 (mod, occ)
117 = (concat $ intersperse [dot] $ reverse modWords, occWord)
118 where
119 (modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
120 parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
121 -- We only look for dots if str could start with a module name,
122 -- i.e. if it starts with an upper case character.
123 -- Otherwise we might think that "X.:->" is the module name in
124 -- "X.:->.+", whereas actually "X" is the module name and
125 -- ":->.+" is a constructor name.
126 parseModOcc acc str@(c : _)
127 | isUpper $ chr $ fromIntegral c
128 = case break (== dot) str of
129 (top, []) -> (acc, top)
130 (top, _ : bot) -> parseModOcc (top : acc) bot
131 parseModOcc acc str = (acc, str)