Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
H
haddock
Manage
Activity
Members
Labels
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Analyze
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Glasgow Haskell Compiler
haddock
Commits
15be7e06
Commit
15be7e06
authored
17 years ago
by
David Waern
Browse files
Options
Downloads
Patches
Plain Diff
Synch loading of names from .haddock files with GHC's name cache
parent
c2170cdb
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
src/Haddock/InterfaceFile.hs
+12
-8
12 additions, 8 deletions
src/Haddock/InterfaceFile.hs
src/Main.hs
+4
-4
4 additions, 4 deletions
src/Main.hs
with
16 additions
and
12 deletions
src/Haddock/InterfaceFile.hs
+
12
−
8
View file @
15be7e06
...
@@ -115,9 +115,9 @@ writeInterfaceFile filename iface = do
...
@@ -115,9 +115,9 @@ writeInterfaceFile filename iface = do
writeBinMem
bh
filename
writeBinMem
bh
filename
return
()
return
()
readInterfaceFile
::
FilePath
->
IO
(
Either
String
InterfaceFile
)
readInterfaceFile
::
Session
->
FilePath
->
IO
(
Either
String
InterfaceFile
)
readInterfaceFile
filename
=
do
readInterfaceFile
session
filename
=
do
bh
<-
readBinMem
filename
bh
<-
readBinMem
filename
magic
<-
get
bh
magic
<-
get
bh
...
@@ -140,17 +140,21 @@ readInterfaceFile filename = do
...
@@ -140,17 +140,21 @@ readInterfaceFile filename = do
-- initialise the user-data field of bh
-- initialise the user-data field of bh
ud
<-
newReadState
dict
ud
<-
newReadState
dict
bh
<-
return
(
setUserData
bh
ud
)
bh
<-
return
(
setUserData
bh
ud
)
-- get the name cache from the ghc session
ncRef
<-
withSession
session
(
return
.
hsc_NC
)
nc
<-
readIORef
ncRef
-- get the symbol table
-- get the symbol table
symtab_p
<-
get
bh
symtab_p
<-
get
bh
data_p
<-
tellBin
bh
data_p
<-
tellBin
bh
seekBin
bh
symtab_p
seekBin
bh
symtab_p
-- (construct an empty name cache)
(
nc'
,
symtab
)
<-
getSymbolTable
bh
nc
u
<-
mkSplitUniqSupply
'a'
-- ??
let
nc
=
initNameCache
u
[]
(
_
,
symtab
)
<-
getSymbolTable
bh
nc
seekBin
bh
data_p
seekBin
bh
data_p
-- write back the new name cache
writeIORef
ncRef
nc'
-- set the symbol table
-- set the symbol table
let
ud
=
getUserData
bh
let
ud
=
getUserData
bh
bh
<-
return
$!
setUserData
bh
ud
{
ud_symtab
=
symtab
}
bh
<-
return
$!
setUserData
bh
ud
{
ud_symtab
=
symtab
}
...
...
This diff is collapsed.
Click to expand it.
src/Main.hs
+
4
−
4
View file @
15be7e06
...
@@ -107,7 +107,7 @@ main = handleTopExceptions $ do
...
@@ -107,7 +107,7 @@ main = handleTopExceptions $ do
(
session
,
dynflags
)
<-
startGhc
libDir
(
ghcFlags
flags
)
(
session
,
dynflags
)
<-
startGhc
libDir
(
ghcFlags
flags
)
-- get packages via --read-interface
-- get packages via --read-interface
packages
<-
readInterfaceFiles
(
ifacePairs
flags
)
packages
<-
readInterfaceFiles
session
(
ifacePairs
flags
)
-- typecheck argument modules using GHC
-- typecheck argument modules using GHC
modules
<-
typecheckFiles
session
fileArgs
modules
<-
typecheckFiles
session
fileArgs
...
@@ -212,14 +212,14 @@ render flags interfaces = do
...
@@ -212,14 +212,14 @@ render flags interfaces = do
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
readInterfaceFiles
::
[(
FilePath
,
FilePath
)]
->
IO
[(
InterfaceFile
,
FilePath
)]
readInterfaceFiles
::
Session
->
[(
FilePath
,
FilePath
)]
->
IO
[(
InterfaceFile
,
FilePath
)]
readInterfaceFiles
pairs
=
do
readInterfaceFiles
session
pairs
=
do
mbPackages
<-
mapM
tryReadIface
pairs
mbPackages
<-
mapM
tryReadIface
pairs
return
(
catMaybes
mbPackages
)
return
(
catMaybes
mbPackages
)
where
where
-- try to read an interface, warn if we can't
-- try to read an interface, warn if we can't
tryReadIface
(
html
,
iface
)
=
do
tryReadIface
(
html
,
iface
)
=
do
eIface
<-
readInterfaceFile
iface
eIface
<-
readInterfaceFile
session
iface
case
eIface
of
case
eIface
of
Left
err
->
do
Left
err
->
do
putStrLn
(
"Warning: Cannot read "
++
iface
++
":"
)
putStrLn
(
"Warning: Cannot read "
++
iface
++
":"
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment