[Git][ghc/ghc][master] Allow atomic update of NameCache in readHieFile
Marge Bot
gitlab at gitlab.haskell.org
Wed May 6 08:41:26 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00
Allow atomic update of NameCache in readHieFile
The situation arises in ghcide where multiple different threads may need to
update the name cache, therefore with the older interface it could happen
that you start reading a hie file with name cache A and produce name cache
A + B, but another thread in the meantime updated the namecache to A +
C. Therefore if you write the new namecache you will lose the A' updates
from the second thread.
Updates haddock submodule
- - - - -
4 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Ext/Binary.hs
- testsuite/tests/hiefile/should_run/PatTypes.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -178,7 +178,7 @@ import Control.DeepSeq (force)
import GHC.Iface.Ext.Ast ( mkHieFile )
import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module )
-import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result)
+import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result, NameCacheUpdater(..))
import GHC.Iface.Ext.Debug ( diffFile, validateScopes )
#include "HsVersions.h"
@@ -438,8 +438,7 @@ extract_renamed_stuff mod_summary tc_result = do
putMsg dflags $ text "Got invalid scopes"
mapM_ (putMsg dflags) xs
-- Roundtrip testing
- nc <- readIORef $ hsc_NC hs_env
- (file', _) <- readHieFile nc out_file
+ file' <- readHieFile (NCU $ updNameCache $ hsc_NC hs_env) out_file
case diffFile hieFile (hie_file_result file') of
[] ->
putMsg dflags $ text "Got no roundtrip errors"
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -12,6 +12,7 @@ module GHC.Iface.Ext.Binary
, HieFileResult(..)
, hieMagic
, hieNameOcc
+ , NameCacheUpdater(..)
)
where
@@ -33,6 +34,7 @@ import GHC.Types.Unique.Supply ( takeUniqFromSupply )
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Utils.Misc
+import GHC.Iface.Env (NameCacheUpdater(..))
import qualified Data.Array as A
import Data.IORef
@@ -189,23 +191,23 @@ type HieHeader = (Integer, ByteString)
-- an existing `NameCache`. Allows you to specify
-- which versions of hieFile to attempt to read.
-- `Left` case returns the failing header versions.
-readHieFileWithVersion :: (HieHeader -> Bool) -> NameCache -> FilePath -> IO (Either HieHeader (HieFileResult, NameCache))
-readHieFileWithVersion readVersion nc file = do
+readHieFileWithVersion :: (HieHeader -> Bool) -> NameCacheUpdater -> FilePath -> IO (Either HieHeader HieFileResult)
+readHieFileWithVersion readVersion ncu file = do
bh0 <- readBinMem file
(hieVersion, ghcVersion) <- readHieFileHeader file bh0
if readVersion (hieVersion, ghcVersion)
then do
- (hieFile, nc') <- readHieFileContents bh0 nc
- return $ Right (HieFileResult hieVersion ghcVersion hieFile, nc')
+ hieFile <- readHieFileContents bh0 ncu
+ return $ Right (HieFileResult hieVersion ghcVersion hieFile)
else return $ Left (hieVersion, ghcVersion)
-- | Read a `HieFile` from a `FilePath`. Can use
-- an existing `NameCache`.
-readHieFile :: NameCache -> FilePath -> IO (HieFileResult, NameCache)
-readHieFile nc file = do
+readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult
+readHieFile ncu file = do
bh0 <- readBinMem file
@@ -219,8 +221,8 @@ readHieFile nc file = do
, show hieVersion
, "but got", show readHieVersion
]
- (hieFile, nc') <- readHieFileContents bh0 nc
- return $ (HieFileResult hieVersion ghcVersion hieFile, nc')
+ hieFile <- readHieFileContents bh0 ncu
+ return $ HieFileResult hieVersion ghcVersion hieFile
readBinLine :: BinHandle -> IO ByteString
readBinLine bh = BS.pack . reverse <$> loop []
@@ -254,24 +256,24 @@ readHieFileHeader file bh0 = do
]
return (readHieVersion, ghcVersion)
-readHieFileContents :: BinHandle -> NameCache -> IO (HieFile, NameCache)
-readHieFileContents bh0 nc = do
+readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile
+readHieFileContents bh0 ncu = do
dict <- get_dictionary bh0
-- read the symbol table so we are capable of reading the actual data
- (bh1, nc') <- do
+ bh1 <- do
let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
(getDictFastString dict)
- (nc', symtab) <- get_symbol_table bh1
+ symtab <- get_symbol_table bh1
let bh1' = setUserData bh1
$ newReadState (getSymTabName symtab)
(getDictFastString dict)
- return (bh1', nc')
+ return bh1'
-- load the actual data
hiefile <- get bh1
- return (hiefile, nc')
+ return hiefile
where
get_dictionary bin_handle = do
dict_p <- get bin_handle
@@ -285,9 +287,9 @@ readHieFileContents bh0 nc = do
symtab_p <- get bh1
data_p' <- tellBin bh1
seekBin bh1 symtab_p
- (nc', symtab) <- getSymbolTable bh1 nc
+ symtab <- getSymbolTable bh1 ncu
seekBin bh1 data_p'
- return (nc', symtab)
+ return symtab
putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
putFastString HieDictionary { hie_dict_next = j_r,
@@ -309,13 +311,14 @@ putSymbolTable bh next_off symtab = do
let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))
mapM_ (putHieName bh) names
-getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, SymbolTable)
-getSymbolTable bh namecache = do
+getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
+getSymbolTable bh ncu = do
sz <- get bh
od_names <- replicateM sz (getHieName bh)
- let arr = A.listArray (0,sz-1) names
- (namecache', names) = mapAccumR fromHieName namecache od_names
- return (namecache', arr)
+ updateNameCache ncu $ \nc ->
+ let arr = A.listArray (0,sz-1) names
+ (nc', names) = mapAccumR fromHieName nc od_names
+ in (nc',arr)
getSymTabName :: SymbolTable -> BinHandle -> IO Name
getSymTabName st bh = do
=====================================
testsuite/tests/hiefile/should_run/PatTypes.hs
=====================================
@@ -57,7 +57,7 @@ main = do
libdir:_ <- getArgs
df <- dynFlagsForPrinting libdir
nc <- makeNc
- (hfr, nc') <- readHieFile nc "PatTypes.hie"
+ hfr <- readHieFile (NCU (\f -> pure $ snd $ f nc)) "PatTypes.hie"
let hf = hie_file_result hfr
forM_ [p1,p2,p3,p4] $ \point -> do
putStr $ "At " ++ show point ++ ", got type: "
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit c60995fe05d9cc267e892448604b8b96a705ccc7
+Subproject commit 97f301a63ea8461074bfaa1486eb798e4be65f15
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f3e6884e338015f2953c4c0844e04d467f53dd5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f3e6884e338015f2953c4c0844e04d467f53dd5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200506/cfd74c01/attachment-0001.html>
More information about the ghc-commits
mailing list