Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
9c54ee0c
Commit
9c54ee0c
authored
May 09, 2007
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Store the constructor name in the info table in UTF-8
parent
ab13303c
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
61 additions
and
36 deletions
+61
-36
compiler/basicTypes/DataCon.lhs
compiler/basicTypes/DataCon.lhs
+18
-13
compiler/codeGen/CgInfoTbls.hs
compiler/codeGen/CgInfoTbls.hs
+9
-2
compiler/codeGen/CgUtils.hs
compiler/codeGen/CgUtils.hs
+1
-1
compiler/ghci/ByteCodeItbls.lhs
compiler/ghci/ByteCodeItbls.lhs
+2
-2
compiler/ghci/Linker.lhs
compiler/ghci/Linker.lhs
+21
-18
compiler/utils/FastString.lhs
compiler/utils/FastString.lhs
+10
-0
No files found.
compiler/basicTypes/DataCon.lhs
View file @
9c54ee0c
...
...
@@ -43,6 +43,11 @@ import ListSetOps
import Util
import Maybes
import FastString
import PackageConfig
import Module
import Data.Char
import Data.Word
\end{code}
...
...
@@ -518,19 +523,6 @@ mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
dataConName :: DataCon -> Name
dataConName = dcName
-- generate a name in the format: package:Module.OccName
-- and the unique identity of the name
dataConIdentity :: DataCon -> String
dataConIdentity dataCon
= prettyName
where
prettyName = pretty packageModule ++ "." ++ pretty occ
nm = getName dataCon
packageModule = nameModule nm
occ = getOccName dataCon
pretty :: Outputable a => a -> String
pretty = showSDoc . ppr
dataConTag :: DataCon -> ConTag
dataConTag = dcTag
...
...
@@ -694,6 +686,19 @@ dataConRepArgTys :: DataCon -> [Type]
dataConRepArgTys dc = dcRepArgTys dc
\end{code}
The string <package>:<module>.<name> identifying a constructor, which is attached
to its info table and used by the GHCi debugger and the heap profiler. We want
this string to be UTF-8, so we get the bytes directly from the FastStrings.
\begin{code}
dataConIdentity :: DataCon -> [Word8]
dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
where name = dataConName dc
mod = nameModule name
\end{code}
\begin{code}
isTupleCon :: DataCon -> Bool
...
...
compiler/codeGen/CgInfoTbls.hs
View file @
9c54ee0c
...
...
@@ -43,12 +43,18 @@ import Name
import
DataCon
import
Unique
import
StaticFlags
import
FastString
import
Packages
import
Module
import
Maybes
import
Constants
import
Outputable
import
Data.Char
import
Data.Word
-------------------------------------------------------------------------
--
-- Generating the info table and code for a closure
...
...
@@ -89,7 +95,7 @@ emitClosureCodeAndInfoTable cl_info args body
;
conName
<-
if
is_con
then
do
cstr
<-
mkStringCLit
$
fromJust
conIdentity
then
do
cstr
<-
mk
Byte
StringCLit
$
fromJust
conIdentity
return
(
makeRelativeRefTo
info_lbl
cstr
)
else
return
(
mkIntCLit
0
)
...
...
@@ -111,7 +117,8 @@ emitClosureCodeAndInfoTable cl_info args body
Just
con
->
-- Constructors don't have an SRT
-- We keep the *zero-indexed* tag in the srt_len
-- field of the info table.
(
mkIntCLit
0
,
fromIntegral
(
dataConTagZ
con
),
Just
$
dataConIdentity
con
)
(
mkIntCLit
0
,
fromIntegral
(
dataConTagZ
con
),
Just
$
dataConIdentity
con
)
Nothing
->
-- Not a constructor
let
(
label
,
len
)
=
srtLabelAndLength
srt
info_lbl
...
...
compiler/codeGen/CgUtils.hs
View file @
9c54ee0c
...
...
@@ -26,7 +26,7 @@ module CgUtils (
addToMem
,
addToMemE
,
mkWordCLit
,
mkStringCLit
,
mkStringCLit
,
mkByteStringCLit
,
packHalfWordsCLit
,
blankWord
)
where
...
...
compiler/ghci/ByteCodeItbls.lhs
View file @
9c54ee0c
...
...
@@ -117,7 +117,7 @@ make_constr_itbls cons
, code = code
#endif
}
qNameCString <- new
CString
$ dataConIdentity dcon
qNameCString <- new
Array0 0
$ dataConIdentity dcon
let conInfoTbl = StgConInfoTable {
conDesc = qNameCString,
infoTable = itbl
...
...
@@ -273,7 +273,7 @@ type HalfWord = Word16
#endif
data StgConInfoTable = StgConInfoTable {
conDesc ::
CString
,
conDesc ::
Ptr Word8
,
infoTable :: StgInfoTable
}
...
...
compiler/ghci/Linker.lhs
View file @
9c54ee0c
...
...
@@ -55,16 +55,15 @@ import DriverPhases
import SrcLoc
import UniqSet
import Constants
import FastString
-- Standard libraries
import Control.Monad
import Data.Char
import Data.IORef
import Data.List
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Storable
import Foreign
import System.IO
import System.Directory
...
...
@@ -152,9 +151,10 @@ deleteFromLinkEnv to_remove
new_pls = pls { closure_env = new_closure_env }
writeIORef v_PersistentLinkerState new_pls
-- | Given a data constructor, find its internal name.
-- The info tables for data constructors have a field which records the source name
-- of the constructor as a CString. The format is:
-- | 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
--
...
...
@@ -166,11 +166,13 @@ dataConInfoPtrToName x = do
theString <- ioToTcRn $ do
let ptr = castPtr x :: Ptr StgInfoTable
conDescAddress <- getConDescAddress ptr
str <- peekCString conDescAddress
return str
peekArray0 0 conDescAddress
let (pkg, mod, occ) = parse theString
occName = mkOccName OccName.dataName occ
modName = mkModule (stringToPackageId pkg) (mkModuleName mod)
pkgFS = mkFastStringByteList pkg
modFS = mkFastStringByteList mod
occFS = mkFastStringByteList occ
occName = mkOccNameFS OccName.dataName occFS
modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS)
lookupOrig modName occName
where
...
...
@@ -215,7 +217,7 @@ dataConInfoPtrToName x = do
in the memory location: info_table_ptr + info_table_size
-}
getConDescAddress :: Ptr StgInfoTable -> IO (Ptr
CChar
)
getConDescAddress :: Ptr StgInfoTable -> IO (Ptr
Word8
)
getConDescAddress ptr = do
#ifdef GHCI_TABLES_NEXT_TO_CODE
offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
...
...
@@ -231,20 +233,21 @@ dataConInfoPtrToName x = do
-- 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 ::
String -> (String, String, String
)
parse ::
[Word8] -> ([Word8], [Word8], [Word8]
)
parse input
= ASSERT (all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
where
(pkg, rest1) = break (==':') input
dot = fromIntegral (ord '.')
(pkg, rest1) = break (== fromIntegral (ord ':')) input
(mod, occ)
= (concat $ intersperse
"."
$ reverse modWords, occWord)
= (concat $ intersperse
[dot]
$ reverse modWords, occWord)
where
(modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
parseModOcc :: [
String] -> String -> ([String], String
)
parseModOcc :: [
[Word8]] -> [Word8] -> ([[Word8]], [Word8]
)
parseModOcc acc str
= case break (==
'.'
) str of
= case break (==
dot
) str of
(top, []) -> (acc, top)
(top,
'.'
:bot) -> parseModOcc (top : acc) bot
(top,
_
:bot) -> parseModOcc (top : acc) bot
getHValue :: HscEnv -> Name -> IO HValue
...
...
compiler/utils/FastString.lhs
View file @
9c54ee0c
...
...
@@ -24,6 +24,7 @@ module FastString
-- ** Construction
mkFastString,
mkFastStringBytes,
mkFastStringByteList,
mkFastStringForeignPtr,
mkFastString#,
mkZFastString,
...
...
@@ -275,6 +276,15 @@ mkFastString str =
utf8EncodeString ptr str
mkFastStringForeignPtr ptr buf l
-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
mkFastStringByteList :: [Word8] -> FastString
mkFastStringByteList str =
inlinePerformIO $ do
let l = Prelude.length str
buf <- mallocForeignPtrBytes l
withForeignPtr buf $ \ptr -> do
pokeArray (castPtr ptr) str
mkFastStringForeignPtr ptr buf l
-- | Creates a Z-encoded 'FastString' from a 'String'
mkZFastString :: String -> FastString
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment