mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 05:36:09 +03:00
Use a global namecache to read .hie
files (#677)
* Use global NameCache for reading HIE files Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com> * ignore hlint * redundant imports * Use hie files as source of truth for name source spans. Since we started reusing `.hi` files, this exposes a bug where definitions aren't available since a bad source span from the `.hi` file gets put into the NameCache. We rectify by ensuring the span in the NameCache always matches the one from the `.hie` file. This has surfaced because an interaction between the commit which uses `.hi` instead of retypechecking and the change to use the shared global NameCache to read `.hie` files. * Add test for missing definitions Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>
This commit is contained in:
parent
7dc6e2678a
commit
f32f666d2e
14
exe/Main.hs
14
exe/Main.hs
@ -203,12 +203,12 @@ cradleToSessionOpts cradle file = do
|
||||
-- message about the fact that the file is being ignored.
|
||||
CradleNone -> return (Left [])
|
||||
|
||||
emptyHscEnv :: IO HscEnv
|
||||
emptyHscEnv = do
|
||||
emptyHscEnv :: IORef NameCache -> IO HscEnv
|
||||
emptyHscEnv nc = do
|
||||
libdir <- getLibdir
|
||||
env <- runGhc (Just libdir) getSession
|
||||
initDynLinker env
|
||||
pure env
|
||||
pure $ setNameCache nc env
|
||||
|
||||
-- | Convert a target to a list of potential absolute paths.
|
||||
-- A TargetModule can be anywhere listed by the supplied include
|
||||
@ -262,7 +262,7 @@ loadSession dir = do
|
||||
InstallationMismatch{..} ->
|
||||
return $ returnWithVersion $ \fp -> return (([renderPackageSetupException compileTime fp GhcVersionMismatch{..}], Nothing),[])
|
||||
InstallationChecked compileTime ghcLibCheck -> return $ do
|
||||
ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress} <- getShakeExtras
|
||||
ShakeExtras{logger, eventer, restartShakeSession, withIndefiniteProgress, ideNc} <- getShakeExtras
|
||||
IdeOptions{optTesting = IdeTesting optTesting} <- getIdeOptions
|
||||
|
||||
-- Create a new HscEnv from a hieYaml root and a set of options
|
||||
@ -273,7 +273,7 @@ loadSession dir = do
|
||||
-> IO (HscEnv, ComponentInfo, [ComponentInfo])
|
||||
packageSetup (hieYaml, cfp, opts) = do
|
||||
-- Parse DynFlags for the newly discovered component
|
||||
hscEnv <- emptyHscEnv
|
||||
hscEnv <- emptyHscEnv ideNc
|
||||
(df, targets) <- evalGhcEnv hscEnv $
|
||||
setOptions opts (hsc_dflags hscEnv)
|
||||
let deps = componentDependencies opts ++ maybeToList hieYaml
|
||||
@ -317,9 +317,7 @@ loadSession dir = do
|
||||
-- It's important to keep the same NameCache though for reasons
|
||||
-- that I do not fully understand
|
||||
logInfo logger (T.pack ("Making new HscEnv" ++ show inplace))
|
||||
hscEnv <- case oldDeps of
|
||||
Nothing -> emptyHscEnv
|
||||
Just (old_hsc, _) -> setNameCache (hsc_NC old_hsc) <$> emptyHscEnv
|
||||
hscEnv <- emptyHscEnv ideNc
|
||||
newHscEnv <-
|
||||
-- Add the options for the current component to the HscEnv
|
||||
evalGhcEnv hscEnv $ do
|
||||
|
@ -159,10 +159,12 @@ library
|
||||
hs-source-dirs: src-ghc88
|
||||
other-modules:
|
||||
Development.IDE.GHC.HieAst
|
||||
Development.IDE.GHC.HieBin
|
||||
if (impl(ghc > 8.9))
|
||||
hs-source-dirs: src-ghc810
|
||||
other-modules:
|
||||
Development.IDE.GHC.HieAst
|
||||
Development.IDE.GHC.HieBin
|
||||
ghc-options: -Wall -Wno-name-shadowing
|
||||
|
||||
executable ghcide-test-preprocessor
|
||||
|
399
src-ghc810/Development/IDE/GHC/HieBin.hs
Normal file
399
src-ghc810/Development/IDE/GHC/HieBin.hs
Normal file
@ -0,0 +1,399 @@
|
||||
{-
|
||||
Binary serialization for .hie files.
|
||||
-}
|
||||
{- HLINT ignore -}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Development.IDE.GHC.HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic, hieNameOcc,NameCacheUpdater(..)) where
|
||||
|
||||
import GHC.Settings ( maybeRead )
|
||||
|
||||
import Config ( cProjectVersion )
|
||||
import Binary
|
||||
import BinIface ( getDictFastString )
|
||||
import FastMutInt
|
||||
import FastString ( FastString )
|
||||
import Module ( Module )
|
||||
import Name
|
||||
import NameCache
|
||||
import Outputable
|
||||
import PrelInfo
|
||||
import SrcLoc
|
||||
import UniqSupply ( takeUniqFromSupply )
|
||||
import Unique
|
||||
import UniqFM
|
||||
import IfaceEnv
|
||||
|
||||
import qualified Data.Array as A
|
||||
import Data.IORef
|
||||
import Data.ByteString ( ByteString )
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.List ( mapAccumR )
|
||||
import Data.Word ( Word8, Word32 )
|
||||
import Control.Monad ( replicateM, when )
|
||||
import System.Directory ( createDirectoryIfMissing )
|
||||
import System.FilePath ( takeDirectory )
|
||||
|
||||
import HieTypes
|
||||
|
||||
-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
|
||||
-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
|
||||
-- these two types.
|
||||
data HieName
|
||||
= ExternalName !Module !OccName !SrcSpan
|
||||
| LocalName !OccName !SrcSpan
|
||||
| KnownKeyName !Unique
|
||||
deriving (Eq)
|
||||
|
||||
instance Ord HieName where
|
||||
compare (ExternalName a b c) (ExternalName d e f) = compare (a,b,c) (d,e,f)
|
||||
compare (LocalName a b) (LocalName c d) = compare (a,b) (c,d)
|
||||
compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
|
||||
-- Not actually non determinstic as it is a KnownKey
|
||||
compare ExternalName{} _ = LT
|
||||
compare LocalName{} ExternalName{} = GT
|
||||
compare LocalName{} _ = LT
|
||||
compare KnownKeyName{} _ = GT
|
||||
|
||||
instance Outputable HieName where
|
||||
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
|
||||
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
|
||||
ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
|
||||
|
||||
hieNameOcc :: HieName -> OccName
|
||||
hieNameOcc (ExternalName _ occ _) = occ
|
||||
hieNameOcc (LocalName occ _) = occ
|
||||
hieNameOcc (KnownKeyName u) =
|
||||
case lookupKnownKeyName u of
|
||||
Just n -> nameOccName n
|
||||
Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
|
||||
(ppr (unpkUnique u))
|
||||
|
||||
|
||||
data HieSymbolTable = HieSymbolTable
|
||||
{ hie_symtab_next :: !FastMutInt
|
||||
, hie_symtab_map :: !(IORef (UniqFM (Int, HieName)))
|
||||
}
|
||||
|
||||
data HieDictionary = HieDictionary
|
||||
{ hie_dict_next :: !FastMutInt -- The next index to use
|
||||
, hie_dict_map :: !(IORef (UniqFM (Int,FastString))) -- indexed by FastString
|
||||
}
|
||||
|
||||
initBinMemSize :: Int
|
||||
initBinMemSize = 1024*1024
|
||||
|
||||
-- | The header for HIE files - Capital ASCII letters "HIE".
|
||||
hieMagic :: [Word8]
|
||||
hieMagic = [72,73,69]
|
||||
|
||||
hieMagicLen :: Int
|
||||
hieMagicLen = length hieMagic
|
||||
|
||||
ghcVersion :: ByteString
|
||||
ghcVersion = BSC.pack cProjectVersion
|
||||
|
||||
putBinLine :: BinHandle -> ByteString -> IO ()
|
||||
putBinLine bh xs = do
|
||||
mapM_ (putByte bh) $ BS.unpack xs
|
||||
putByte bh 10 -- newline char
|
||||
|
||||
-- | Write a `HieFile` to the given `FilePath`, with a proper header and
|
||||
-- symbol tables for `Name`s and `FastString`s
|
||||
writeHieFile :: FilePath -> HieFile -> IO ()
|
||||
writeHieFile hie_file_path hiefile = do
|
||||
bh0 <- openBinMem initBinMemSize
|
||||
|
||||
-- Write the header: hieHeader followed by the
|
||||
-- hieVersion and the GHC version used to generate this file
|
||||
mapM_ (putByte bh0) hieMagic
|
||||
putBinLine bh0 $ BSC.pack $ show hieVersion
|
||||
putBinLine bh0 $ ghcVersion
|
||||
|
||||
-- remember where the dictionary pointer will go
|
||||
dict_p_p <- tellBin bh0
|
||||
put_ bh0 dict_p_p
|
||||
|
||||
-- remember where the symbol table pointer will go
|
||||
symtab_p_p <- tellBin bh0
|
||||
put_ bh0 symtab_p_p
|
||||
|
||||
-- Make some intial state
|
||||
symtab_next <- newFastMutInt
|
||||
writeFastMutInt symtab_next 0
|
||||
symtab_map <- newIORef emptyUFM
|
||||
let hie_symtab = HieSymbolTable {
|
||||
hie_symtab_next = symtab_next,
|
||||
hie_symtab_map = symtab_map }
|
||||
dict_next_ref <- newFastMutInt
|
||||
writeFastMutInt dict_next_ref 0
|
||||
dict_map_ref <- newIORef emptyUFM
|
||||
let hie_dict = HieDictionary {
|
||||
hie_dict_next = dict_next_ref,
|
||||
hie_dict_map = dict_map_ref }
|
||||
|
||||
-- put the main thing
|
||||
let bh = setUserData bh0 $ newWriteState (putName hie_symtab)
|
||||
(putName hie_symtab)
|
||||
(putFastString hie_dict)
|
||||
put_ bh hiefile
|
||||
|
||||
-- write the symtab pointer at the front of the file
|
||||
symtab_p <- tellBin bh
|
||||
putAt bh symtab_p_p symtab_p
|
||||
seekBin bh symtab_p
|
||||
|
||||
-- write the symbol table itself
|
||||
symtab_next' <- readFastMutInt symtab_next
|
||||
symtab_map' <- readIORef symtab_map
|
||||
putSymbolTable bh symtab_next' symtab_map'
|
||||
|
||||
-- write the dictionary pointer at the front of the file
|
||||
dict_p <- tellBin bh
|
||||
putAt bh dict_p_p dict_p
|
||||
seekBin bh dict_p
|
||||
|
||||
-- write the dictionary itself
|
||||
dict_next <- readFastMutInt dict_next_ref
|
||||
dict_map <- readIORef dict_map_ref
|
||||
putDictionary bh dict_next dict_map
|
||||
|
||||
-- and send the result to the file
|
||||
createDirectoryIfMissing True (takeDirectory hie_file_path)
|
||||
writeBinMem bh hie_file_path
|
||||
return ()
|
||||
|
||||
data HieFileResult
|
||||
= HieFileResult
|
||||
{ hie_file_result_version :: Integer
|
||||
, hie_file_result_ghc_version :: ByteString
|
||||
, hie_file_result :: HieFile
|
||||
}
|
||||
|
||||
type HieHeader = (Integer, ByteString)
|
||||
|
||||
-- | Read a `HieFile` from a `FilePath`. Can use
|
||||
-- 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) -> 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 <- 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 :: NameCacheUpdater -> FilePath -> IO HieFileResult
|
||||
readHieFile ncu file = do
|
||||
|
||||
bh0 <- readBinMem file
|
||||
|
||||
(readHieVersion, ghcVersion) <- readHieFileHeader file bh0
|
||||
|
||||
-- Check if the versions match
|
||||
when (readHieVersion /= hieVersion) $
|
||||
panic $ unwords ["readHieFile: hie file versions don't match for file:"
|
||||
, file
|
||||
, "Expected"
|
||||
, show hieVersion
|
||||
, "but got", show readHieVersion
|
||||
]
|
||||
hieFile <- readHieFileContents bh0 ncu
|
||||
return $ HieFileResult hieVersion ghcVersion hieFile
|
||||
|
||||
readBinLine :: BinHandle -> IO ByteString
|
||||
readBinLine bh = BS.pack . reverse <$> loop []
|
||||
where
|
||||
loop acc = do
|
||||
char <- get bh :: IO Word8
|
||||
if char == 10 -- ASCII newline '\n'
|
||||
then return acc
|
||||
else loop (char : acc)
|
||||
|
||||
readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader
|
||||
readHieFileHeader file bh0 = do
|
||||
-- Read the header
|
||||
magic <- replicateM hieMagicLen (get bh0)
|
||||
version <- BSC.unpack <$> readBinLine bh0
|
||||
case maybeRead version of
|
||||
Nothing ->
|
||||
panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:"
|
||||
, show version
|
||||
]
|
||||
Just readHieVersion -> do
|
||||
ghcVersion <- readBinLine bh0
|
||||
|
||||
-- Check if the header is valid
|
||||
when (magic /= hieMagic) $
|
||||
panic $ unwords ["readHieFileHeader: headers don't match for file:"
|
||||
, file
|
||||
, "Expected"
|
||||
, show hieMagic
|
||||
, "but got", show magic
|
||||
]
|
||||
return (readHieVersion, ghcVersion)
|
||||
|
||||
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 <- do
|
||||
let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
|
||||
(getDictFastString dict)
|
||||
symtab <- get_symbol_table bh1
|
||||
let bh1' = setUserData bh1
|
||||
$ newReadState (getSymTabName symtab)
|
||||
(getDictFastString dict)
|
||||
return bh1'
|
||||
|
||||
-- load the actual data
|
||||
hiefile <- get bh1
|
||||
return hiefile
|
||||
where
|
||||
get_dictionary bin_handle = do
|
||||
dict_p <- get bin_handle
|
||||
data_p <- tellBin bin_handle
|
||||
seekBin bin_handle dict_p
|
||||
dict <- getDictionary bin_handle
|
||||
seekBin bin_handle data_p
|
||||
return dict
|
||||
|
||||
get_symbol_table bh1 = do
|
||||
symtab_p <- get bh1
|
||||
data_p' <- tellBin bh1
|
||||
seekBin bh1 symtab_p
|
||||
symtab <- getSymbolTable bh1 ncu
|
||||
seekBin bh1 data_p'
|
||||
return symtab
|
||||
|
||||
putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
|
||||
putFastString HieDictionary { hie_dict_next = j_r,
|
||||
hie_dict_map = out_r} bh f
|
||||
= do
|
||||
out <- readIORef out_r
|
||||
let unique = getUnique f
|
||||
case lookupUFM out unique of
|
||||
Just (j, _) -> put_ bh (fromIntegral j :: Word32)
|
||||
Nothing -> do
|
||||
j <- readFastMutInt j_r
|
||||
put_ bh (fromIntegral j :: Word32)
|
||||
writeFastMutInt j_r (j + 1)
|
||||
writeIORef out_r $! addToUFM out unique (j, f)
|
||||
|
||||
putSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO ()
|
||||
putSymbolTable bh next_off symtab = do
|
||||
put_ bh next_off
|
||||
let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))
|
||||
mapM_ (putHieName bh) names
|
||||
|
||||
getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
|
||||
getSymbolTable bh ncu = do
|
||||
sz <- get bh
|
||||
od_names <- replicateM sz (getHieName bh)
|
||||
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
|
||||
i :: Word32 <- get bh
|
||||
return $ st A.! (fromIntegral i)
|
||||
|
||||
putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
|
||||
putName (HieSymbolTable next ref) bh name = do
|
||||
symmap <- readIORef ref
|
||||
case lookupUFM symmap name of
|
||||
Just (off, ExternalName mod occ (UnhelpfulSpan _))
|
||||
| isGoodSrcSpan (nameSrcSpan name) -> do
|
||||
let hieName = ExternalName mod occ (nameSrcSpan name)
|
||||
writeIORef ref $! addToUFM symmap name (off, hieName)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
Just (off, LocalName _occ span)
|
||||
| notLocal (toHieName name) || nameSrcSpan name /= span -> do
|
||||
writeIORef ref $! addToUFM symmap name (off, toHieName name)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
Just (off, _) -> put_ bh (fromIntegral off :: Word32)
|
||||
Nothing -> do
|
||||
off <- readFastMutInt next
|
||||
writeFastMutInt next (off+1)
|
||||
writeIORef ref $! addToUFM symmap name (off, toHieName name)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
|
||||
where
|
||||
notLocal :: HieName -> Bool
|
||||
notLocal LocalName{} = False
|
||||
notLocal _ = True
|
||||
|
||||
|
||||
-- ** Converting to and from `HieName`'s
|
||||
|
||||
toHieName :: Name -> HieName
|
||||
toHieName name
|
||||
| isKnownKeyName name = KnownKeyName (nameUnique name)
|
||||
| isExternalName name = ExternalName (nameModule name)
|
||||
(nameOccName name)
|
||||
(nameSrcSpan name)
|
||||
| otherwise = LocalName (nameOccName name) (nameSrcSpan name)
|
||||
|
||||
fromHieName :: NameCache -> HieName -> (NameCache, Name)
|
||||
fromHieName nc (ExternalName mod occ span) =
|
||||
let cache = nsNames nc
|
||||
in case lookupOrigNameCache cache mod occ of
|
||||
Just name
|
||||
| nameSrcSpan name == span -> (nc, name)
|
||||
| otherwise ->
|
||||
let name' = setNameLoc name span
|
||||
new_cache = extendNameCache cache mod occ name'
|
||||
in ( nc{ nsNames = new_cache }, name' )
|
||||
Nothing ->
|
||||
let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
|
||||
name = mkExternalName uniq mod occ span
|
||||
new_cache = extendNameCache cache mod occ name
|
||||
in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
|
||||
fromHieName nc (LocalName occ span) =
|
||||
let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
|
||||
name = mkInternalName uniq occ span
|
||||
in ( nc{ nsUniqs = us }, name )
|
||||
fromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of
|
||||
Nothing -> pprPanic "fromHieName:unknown known-key unique"
|
||||
(ppr (unpkUnique u))
|
||||
Just n -> (nc, n)
|
||||
|
||||
-- ** Reading and writing `HieName`'s
|
||||
|
||||
putHieName :: BinHandle -> HieName -> IO ()
|
||||
putHieName bh (ExternalName mod occ span) = do
|
||||
putByte bh 0
|
||||
put_ bh (mod, occ, span)
|
||||
putHieName bh (LocalName occName span) = do
|
||||
putByte bh 1
|
||||
put_ bh (occName, span)
|
||||
putHieName bh (KnownKeyName uniq) = do
|
||||
putByte bh 2
|
||||
put_ bh $ unpkUnique uniq
|
||||
|
||||
getHieName :: BinHandle -> IO HieName
|
||||
getHieName bh = do
|
||||
t <- getByte bh
|
||||
case t of
|
||||
0 -> do
|
||||
(modu, occ, span) <- get bh
|
||||
return $ ExternalName modu occ span
|
||||
1 -> do
|
||||
(occ, span) <- get bh
|
||||
return $ LocalName occ span
|
||||
2 -> do
|
||||
(c,i) <- get bh
|
||||
return $ KnownKeyName $ mkUnique c i
|
||||
_ -> panic "HieBin.getHieName: invalid tag"
|
389
src-ghc88/Development/IDE/GHC/HieBin.hs
Normal file
389
src-ghc88/Development/IDE/GHC/HieBin.hs
Normal file
@ -0,0 +1,389 @@
|
||||
{-
|
||||
Binary serialization for .hie files.
|
||||
-}
|
||||
{- HLINT ignore -}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Development.IDE.GHC.HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic,NameCacheUpdater(..)) where
|
||||
|
||||
import Config ( cProjectVersion )
|
||||
import Binary
|
||||
import BinIface ( getDictFastString )
|
||||
import FastMutInt
|
||||
import FastString ( FastString )
|
||||
import Module ( Module )
|
||||
import Name
|
||||
import NameCache
|
||||
import Outputable
|
||||
import PrelInfo
|
||||
import SrcLoc
|
||||
import UniqSupply ( takeUniqFromSupply )
|
||||
import Util ( maybeRead )
|
||||
import Unique
|
||||
import UniqFM
|
||||
import IfaceEnv
|
||||
|
||||
import qualified Data.Array as A
|
||||
import Data.IORef
|
||||
import Data.ByteString ( ByteString )
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.List ( mapAccumR )
|
||||
import Data.Word ( Word8, Word32 )
|
||||
import Control.Monad ( replicateM, when )
|
||||
import System.Directory ( createDirectoryIfMissing )
|
||||
import System.FilePath ( takeDirectory )
|
||||
|
||||
import HieTypes
|
||||
|
||||
-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
|
||||
-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
|
||||
-- these two types.
|
||||
data HieName
|
||||
= ExternalName !Module !OccName !SrcSpan
|
||||
| LocalName !OccName !SrcSpan
|
||||
| KnownKeyName !Unique
|
||||
deriving (Eq)
|
||||
|
||||
instance Ord HieName where
|
||||
compare (ExternalName a b c) (ExternalName d e f) = compare (a,b,c) (d,e,f)
|
||||
compare (LocalName a b) (LocalName c d) = compare (a,b) (c,d)
|
||||
compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
|
||||
-- Not actually non determinstic as it is a KnownKey
|
||||
compare ExternalName{} _ = LT
|
||||
compare LocalName{} ExternalName{} = GT
|
||||
compare LocalName{} _ = LT
|
||||
compare KnownKeyName{} _ = GT
|
||||
|
||||
instance Outputable HieName where
|
||||
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
|
||||
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
|
||||
ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
|
||||
|
||||
|
||||
data HieSymbolTable = HieSymbolTable
|
||||
{ hie_symtab_next :: !FastMutInt
|
||||
, hie_symtab_map :: !(IORef (UniqFM (Int, HieName)))
|
||||
}
|
||||
|
||||
data HieDictionary = HieDictionary
|
||||
{ hie_dict_next :: !FastMutInt -- The next index to use
|
||||
, hie_dict_map :: !(IORef (UniqFM (Int,FastString))) -- indexed by FastString
|
||||
}
|
||||
|
||||
initBinMemSize :: Int
|
||||
initBinMemSize = 1024*1024
|
||||
|
||||
-- | The header for HIE files - Capital ASCII letters "HIE".
|
||||
hieMagic :: [Word8]
|
||||
hieMagic = [72,73,69]
|
||||
|
||||
hieMagicLen :: Int
|
||||
hieMagicLen = length hieMagic
|
||||
|
||||
ghcVersion :: ByteString
|
||||
ghcVersion = BSC.pack cProjectVersion
|
||||
|
||||
putBinLine :: BinHandle -> ByteString -> IO ()
|
||||
putBinLine bh xs = do
|
||||
mapM_ (putByte bh) $ BS.unpack xs
|
||||
putByte bh 10 -- newline char
|
||||
|
||||
-- | Write a `HieFile` to the given `FilePath`, with a proper header and
|
||||
-- symbol tables for `Name`s and `FastString`s
|
||||
writeHieFile :: FilePath -> HieFile -> IO ()
|
||||
writeHieFile hie_file_path hiefile = do
|
||||
bh0 <- openBinMem initBinMemSize
|
||||
|
||||
-- Write the header: hieHeader followed by the
|
||||
-- hieVersion and the GHC version used to generate this file
|
||||
mapM_ (putByte bh0) hieMagic
|
||||
putBinLine bh0 $ BSC.pack $ show hieVersion
|
||||
putBinLine bh0 $ ghcVersion
|
||||
|
||||
-- remember where the dictionary pointer will go
|
||||
dict_p_p <- tellBin bh0
|
||||
put_ bh0 dict_p_p
|
||||
|
||||
-- remember where the symbol table pointer will go
|
||||
symtab_p_p <- tellBin bh0
|
||||
put_ bh0 symtab_p_p
|
||||
|
||||
-- Make some intial state
|
||||
symtab_next <- newFastMutInt
|
||||
writeFastMutInt symtab_next 0
|
||||
symtab_map <- newIORef emptyUFM
|
||||
let hie_symtab = HieSymbolTable {
|
||||
hie_symtab_next = symtab_next,
|
||||
hie_symtab_map = symtab_map }
|
||||
dict_next_ref <- newFastMutInt
|
||||
writeFastMutInt dict_next_ref 0
|
||||
dict_map_ref <- newIORef emptyUFM
|
||||
let hie_dict = HieDictionary {
|
||||
hie_dict_next = dict_next_ref,
|
||||
hie_dict_map = dict_map_ref }
|
||||
|
||||
-- put the main thing
|
||||
let bh = setUserData bh0 $ newWriteState (putName hie_symtab)
|
||||
(putName hie_symtab)
|
||||
(putFastString hie_dict)
|
||||
put_ bh hiefile
|
||||
|
||||
-- write the symtab pointer at the front of the file
|
||||
symtab_p <- tellBin bh
|
||||
putAt bh symtab_p_p symtab_p
|
||||
seekBin bh symtab_p
|
||||
|
||||
-- write the symbol table itself
|
||||
symtab_next' <- readFastMutInt symtab_next
|
||||
symtab_map' <- readIORef symtab_map
|
||||
putSymbolTable bh symtab_next' symtab_map'
|
||||
|
||||
-- write the dictionary pointer at the front of the file
|
||||
dict_p <- tellBin bh
|
||||
putAt bh dict_p_p dict_p
|
||||
seekBin bh dict_p
|
||||
|
||||
-- write the dictionary itself
|
||||
dict_next <- readFastMutInt dict_next_ref
|
||||
dict_map <- readIORef dict_map_ref
|
||||
putDictionary bh dict_next dict_map
|
||||
|
||||
-- and send the result to the file
|
||||
createDirectoryIfMissing True (takeDirectory hie_file_path)
|
||||
writeBinMem bh hie_file_path
|
||||
return ()
|
||||
|
||||
data HieFileResult
|
||||
= HieFileResult
|
||||
{ hie_file_result_version :: Integer
|
||||
, hie_file_result_ghc_version :: ByteString
|
||||
, hie_file_result :: HieFile
|
||||
}
|
||||
|
||||
type HieHeader = (Integer, ByteString)
|
||||
|
||||
-- | Read a `HieFile` from a `FilePath`. Can use
|
||||
-- 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) -> 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 <- 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 :: NameCacheUpdater -> FilePath -> IO HieFileResult
|
||||
readHieFile ncu file = do
|
||||
|
||||
bh0 <- readBinMem file
|
||||
|
||||
(readHieVersion, ghcVersion) <- readHieFileHeader file bh0
|
||||
|
||||
-- Check if the versions match
|
||||
when (readHieVersion /= hieVersion) $
|
||||
panic $ unwords ["readHieFile: hie file versions don't match for file:"
|
||||
, file
|
||||
, "Expected"
|
||||
, show hieVersion
|
||||
, "but got", show readHieVersion
|
||||
]
|
||||
hieFile <- readHieFileContents bh0 ncu
|
||||
return $ HieFileResult hieVersion ghcVersion hieFile
|
||||
|
||||
readBinLine :: BinHandle -> IO ByteString
|
||||
readBinLine bh = BS.pack . reverse <$> loop []
|
||||
where
|
||||
loop acc = do
|
||||
char <- get bh :: IO Word8
|
||||
if char == 10 -- ASCII newline '\n'
|
||||
then return acc
|
||||
else loop (char : acc)
|
||||
|
||||
readHieFileHeader :: FilePath -> BinHandle -> IO HieHeader
|
||||
readHieFileHeader file bh0 = do
|
||||
-- Read the header
|
||||
magic <- replicateM hieMagicLen (get bh0)
|
||||
version <- BSC.unpack <$> readBinLine bh0
|
||||
case maybeRead version of
|
||||
Nothing ->
|
||||
panic $ unwords ["readHieFileHeader: hieVersion isn't an Integer:"
|
||||
, show version
|
||||
]
|
||||
Just readHieVersion -> do
|
||||
ghcVersion <- readBinLine bh0
|
||||
|
||||
-- Check if the header is valid
|
||||
when (magic /= hieMagic) $
|
||||
panic $ unwords ["readHieFileHeader: headers don't match for file:"
|
||||
, file
|
||||
, "Expected"
|
||||
, show hieMagic
|
||||
, "but got", show magic
|
||||
]
|
||||
return (readHieVersion, ghcVersion)
|
||||
|
||||
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 <- do
|
||||
let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
|
||||
(getDictFastString dict)
|
||||
symtab <- get_symbol_table bh1
|
||||
let bh1' = setUserData bh1
|
||||
$ newReadState (getSymTabName symtab)
|
||||
(getDictFastString dict)
|
||||
return bh1'
|
||||
|
||||
-- load the actual data
|
||||
hiefile <- get bh1
|
||||
return hiefile
|
||||
where
|
||||
get_dictionary bin_handle = do
|
||||
dict_p <- get bin_handle
|
||||
data_p <- tellBin bin_handle
|
||||
seekBin bin_handle dict_p
|
||||
dict <- getDictionary bin_handle
|
||||
seekBin bin_handle data_p
|
||||
return dict
|
||||
|
||||
get_symbol_table bh1 = do
|
||||
symtab_p <- get bh1
|
||||
data_p' <- tellBin bh1
|
||||
seekBin bh1 symtab_p
|
||||
symtab <- getSymbolTable bh1 ncu
|
||||
seekBin bh1 data_p'
|
||||
return symtab
|
||||
|
||||
putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
|
||||
putFastString HieDictionary { hie_dict_next = j_r,
|
||||
hie_dict_map = out_r} bh f
|
||||
= do
|
||||
out <- readIORef out_r
|
||||
let unique = getUnique f
|
||||
case lookupUFM out unique of
|
||||
Just (j, _) -> put_ bh (fromIntegral j :: Word32)
|
||||
Nothing -> do
|
||||
j <- readFastMutInt j_r
|
||||
put_ bh (fromIntegral j :: Word32)
|
||||
writeFastMutInt j_r (j + 1)
|
||||
writeIORef out_r $! addToUFM out unique (j, f)
|
||||
|
||||
putSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO ()
|
||||
putSymbolTable bh next_off symtab = do
|
||||
put_ bh next_off
|
||||
let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))
|
||||
mapM_ (putHieName bh) names
|
||||
|
||||
getSymbolTable :: BinHandle -> NameCacheUpdater -> IO SymbolTable
|
||||
getSymbolTable bh ncu = do
|
||||
sz <- get bh
|
||||
od_names <- replicateM sz (getHieName bh)
|
||||
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
|
||||
i :: Word32 <- get bh
|
||||
return $ st A.! (fromIntegral i)
|
||||
|
||||
putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
|
||||
putName (HieSymbolTable next ref) bh name = do
|
||||
symmap <- readIORef ref
|
||||
case lookupUFM symmap name of
|
||||
Just (off, ExternalName mod occ (UnhelpfulSpan _))
|
||||
| isGoodSrcSpan (nameSrcSpan name) -> do
|
||||
let hieName = ExternalName mod occ (nameSrcSpan name)
|
||||
writeIORef ref $! addToUFM symmap name (off, hieName)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
Just (off, LocalName _occ span)
|
||||
| notLocal (toHieName name) || nameSrcSpan name /= span -> do
|
||||
writeIORef ref $! addToUFM symmap name (off, toHieName name)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
Just (off, _) -> put_ bh (fromIntegral off :: Word32)
|
||||
Nothing -> do
|
||||
off <- readFastMutInt next
|
||||
writeFastMutInt next (off+1)
|
||||
writeIORef ref $! addToUFM symmap name (off, toHieName name)
|
||||
put_ bh (fromIntegral off :: Word32)
|
||||
|
||||
where
|
||||
notLocal :: HieName -> Bool
|
||||
notLocal LocalName{} = False
|
||||
notLocal _ = True
|
||||
|
||||
|
||||
-- ** Converting to and from `HieName`'s
|
||||
|
||||
toHieName :: Name -> HieName
|
||||
toHieName name
|
||||
| isKnownKeyName name = KnownKeyName (nameUnique name)
|
||||
| isExternalName name = ExternalName (nameModule name)
|
||||
(nameOccName name)
|
||||
(nameSrcSpan name)
|
||||
| otherwise = LocalName (nameOccName name) (nameSrcSpan name)
|
||||
|
||||
fromHieName :: NameCache -> HieName -> (NameCache, Name)
|
||||
fromHieName nc (ExternalName mod occ span) =
|
||||
let cache = nsNames nc
|
||||
in case lookupOrigNameCache cache mod occ of
|
||||
Just name
|
||||
| nameSrcSpan name == span -> (nc, name)
|
||||
| otherwise ->
|
||||
let name' = setNameLoc name span
|
||||
new_cache = extendNameCache cache mod occ name'
|
||||
in ( nc{ nsNames = new_cache }, name' )
|
||||
Nothing ->
|
||||
let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
|
||||
name = mkExternalName uniq mod occ span
|
||||
new_cache = extendNameCache cache mod occ name
|
||||
in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
|
||||
fromHieName nc (LocalName occ span) =
|
||||
let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
|
||||
name = mkInternalName uniq occ span
|
||||
in ( nc{ nsUniqs = us }, name )
|
||||
fromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of
|
||||
Nothing -> pprPanic "fromHieName:unknown known-key unique"
|
||||
(ppr (unpkUnique u))
|
||||
Just n -> (nc, n)
|
||||
|
||||
-- ** Reading and writing `HieName`'s
|
||||
|
||||
putHieName :: BinHandle -> HieName -> IO ()
|
||||
putHieName bh (ExternalName mod occ span) = do
|
||||
putByte bh 0
|
||||
put_ bh (mod, occ, span)
|
||||
putHieName bh (LocalName occName span) = do
|
||||
putByte bh 1
|
||||
put_ bh (occName, span)
|
||||
putHieName bh (KnownKeyName uniq) = do
|
||||
putByte bh 2
|
||||
put_ bh $ unpkUnique uniq
|
||||
|
||||
getHieName :: BinHandle -> IO HieName
|
||||
getHieName bh = do
|
||||
t <- getByte bh
|
||||
case t of
|
||||
0 -> do
|
||||
(modu, occ, span) <- get bh
|
||||
return $ ExternalName modu occ span
|
||||
1 -> do
|
||||
(occ, span) <- get bh
|
||||
return $ LocalName occ span
|
||||
2 -> do
|
||||
(c,i) <- get bh
|
||||
return $ KnownKeyName $ mkUnique c i
|
||||
_ -> panic "HieBin.getHieName: invalid tag"
|
@ -60,7 +60,6 @@ import GhcPlugins as GHC hiding (fst3, (<>))
|
||||
import qualified HeaderInfo as Hdr
|
||||
import HscMain (hscInteractive, hscSimplify)
|
||||
import MkIface
|
||||
import NameCache
|
||||
import StringBuffer as SB
|
||||
import TcRnMonad (initIfaceLoad, tcg_th_coreplugins)
|
||||
import TcIface (typecheckIface)
|
||||
@ -588,11 +587,9 @@ removePackageImports pkgs (L l h@HsModule {hsmodImports} ) = L l (h { hsmodImpor
|
||||
do_one_import l = l
|
||||
#endif
|
||||
|
||||
loadHieFile :: FilePath -> IO GHC.HieFile
|
||||
loadHieFile f = do
|
||||
u <- mkSplitUniqSupply 'a'
|
||||
let nameCache = initNameCache u []
|
||||
fmap (GHC.hie_file_result . fst) $ GHC.readHieFile nameCache f
|
||||
loadHieFile :: Compat.NameCacheUpdater -> FilePath -> IO GHC.HieFile
|
||||
loadHieFile ncu f = do
|
||||
GHC.hie_file_result <$> GHC.readHieFile ncu f
|
||||
|
||||
-- | Retuns an up-to-date module interface, regenerating if needed.
|
||||
-- Assumes file exists.
|
||||
|
@ -178,7 +178,8 @@ getHomeHieFile f = do
|
||||
|
||||
if isUpToDate
|
||||
then do
|
||||
hf <- liftIO $ whenMaybe isUpToDate (loadHieFile hie_f)
|
||||
ncu <- mkUpdater
|
||||
hf <- liftIO $ whenMaybe isUpToDate (loadHieFile ncu hie_f)
|
||||
MaybeT $ return hf
|
||||
else do
|
||||
wait <- lift $ delayedAction $ mkDelayedAction "OutOfDateHie" L.Info $ do
|
||||
@ -186,7 +187,8 @@ getHomeHieFile f = do
|
||||
pm <- use_ GetParsedModule f
|
||||
typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles
|
||||
_ <- MaybeT $ liftIO $ timeout 1 wait
|
||||
liftIO $ loadHieFile hie_f
|
||||
ncu <- mkUpdater
|
||||
liftIO $ loadHieFile ncu hie_f
|
||||
|
||||
|
||||
getPackageHieFile :: ShakeExtras
|
||||
@ -203,10 +205,11 @@ getPackageHieFile ide mod file = do
|
||||
hieFile <- liftIO $ optLocateHieFile optPkgLocationOpts pkgConfig mod
|
||||
path <- liftIO $ optLocateSrcFile optPkgLocationOpts pkgConfig mod
|
||||
case (hieFile, path) of
|
||||
(Just hiePath, Just modPath) -> MaybeT $
|
||||
(Just hiePath, Just modPath) -> do
|
||||
-- deliberately loaded outside the Shake graph
|
||||
-- to avoid dependencies on non-workspace files
|
||||
liftIO $ Just . (, modPath) <$> loadHieFile hiePath
|
||||
ncu <- mkUpdater
|
||||
MaybeT $ liftIO $ Just . (, modPath) <$> loadHieFile ncu hiePath
|
||||
_ -> MaybeT $ return Nothing
|
||||
_ -> MaybeT $ return Nothing
|
||||
|
||||
|
@ -56,7 +56,8 @@ module Development.IDE.Core.Shake(
|
||||
WithProgressFunc, WithIndefiniteProgressFunc,
|
||||
ProgressEvent(..),
|
||||
DelayedAction, mkDelayedAction,
|
||||
IdeAction(..), runIdeAction
|
||||
IdeAction(..), runIdeAction,
|
||||
mkUpdater
|
||||
) where
|
||||
|
||||
import Development.Shake hiding (ShakeValue, doesFileExist, Info)
|
||||
@ -75,6 +76,7 @@ import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import Data.Unique
|
||||
import Development.IDE.Core.Debouncer
|
||||
import Development.IDE.GHC.Compat ( NameCacheUpdater(..), upNameCache )
|
||||
import Development.IDE.Core.PositionMapping
|
||||
import Development.IDE.Types.Logger hiding (Priority)
|
||||
import qualified Development.IDE.Types.Logger as Logger
|
||||
@ -105,8 +107,13 @@ import Data.Foldable (traverse_)
|
||||
import qualified Control.Monad.STM as STM
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Traversable
|
||||
|
||||
import Data.IORef
|
||||
import NameCache
|
||||
import UniqSupply
|
||||
import PrelInfo
|
||||
|
||||
-- information we stash inside the shakeExtra field
|
||||
data ShakeExtras = ShakeExtras
|
||||
@ -138,6 +145,7 @@ data ShakeExtras = ShakeExtras
|
||||
,withIndefiniteProgress :: WithIndefiniteProgressFunc
|
||||
-- ^ Same as 'withProgress', but for processes that do not report the percentage complete
|
||||
,restartShakeSession :: [DelayedAction ()] -> IO ()
|
||||
, ideNc :: IORef NameCache
|
||||
}
|
||||
|
||||
type WithProgressFunc = forall a.
|
||||
@ -373,6 +381,8 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
|
||||
shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) opts rules = mdo
|
||||
|
||||
inProgress <- newVar HMap.empty
|
||||
us <- mkSplitUniqSupply 'r'
|
||||
ideNc <- newIORef (initNameCache us knownKeyNames)
|
||||
(shakeExtras, stopProgressReporting) <- do
|
||||
globals <- newVar HMap.empty
|
||||
state <- newVar HMap.empty
|
||||
@ -708,6 +718,11 @@ runIdeAction _herald s i = runReaderT (runIdeActionT i) s
|
||||
askShake :: IdeAction ShakeExtras
|
||||
askShake = ask
|
||||
|
||||
mkUpdater :: MaybeT IdeAction NameCacheUpdater
|
||||
mkUpdater = do
|
||||
ref <- lift $ ideNc <$> askShake
|
||||
pure $ NCU (upNameCache ref)
|
||||
|
||||
-- | A (maybe) stale result now, and an up to date one later
|
||||
data FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: IO (Maybe a) }
|
||||
|
||||
|
@ -12,9 +12,9 @@
|
||||
module Development.IDE.GHC.Compat(
|
||||
getHeaderImports,
|
||||
HieFileResult(..),
|
||||
HieFile,
|
||||
HieFile(..),
|
||||
NameCacheUpdater(..),
|
||||
hieExportNames,
|
||||
hie_module,
|
||||
mkHieFile,
|
||||
writeHieFile,
|
||||
readHieFile,
|
||||
@ -49,7 +49,13 @@ module Development.IDE.GHC.Compat(
|
||||
HasSrcSpan,
|
||||
getLoc,
|
||||
|
||||
module GHC
|
||||
upNameCache,
|
||||
|
||||
module GHC,
|
||||
#if MIN_GHC_API_VERSION(8,8,0)
|
||||
module HieTypes,
|
||||
module HieUtils,
|
||||
#endif
|
||||
) where
|
||||
|
||||
import StringBuffer
|
||||
@ -58,6 +64,9 @@ import FieldLabel
|
||||
import Fingerprint (Fingerprint)
|
||||
import qualified Module
|
||||
import Packages
|
||||
import Data.IORef
|
||||
import HscTypes
|
||||
import NameCache
|
||||
|
||||
import qualified GHC
|
||||
import GHC hiding (
|
||||
@ -84,13 +93,10 @@ import Avail
|
||||
import ErrUtils (ErrorMessages)
|
||||
import FastString (FastString)
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,10,0)
|
||||
import HscTypes (mi_mod_hash)
|
||||
#endif
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,8,0)
|
||||
import Development.IDE.GHC.HieAst (mkHieFile)
|
||||
import HieBin
|
||||
import Development.IDE.GHC.HieBin
|
||||
import HieUtils
|
||||
import HieTypes
|
||||
|
||||
supportsHieFiles :: Bool
|
||||
@ -101,10 +107,9 @@ hieExportNames = nameListFromAvails . hie_exports
|
||||
|
||||
#else
|
||||
|
||||
import IfaceEnv
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
import BinIface
|
||||
import Data.IORef
|
||||
import IfaceEnv
|
||||
#else
|
||||
import System.IO.Error
|
||||
#endif
|
||||
@ -113,7 +118,6 @@ import Binary
|
||||
import Control.Exception (catch)
|
||||
import Data.ByteString (ByteString)
|
||||
import GhcPlugins (Hsc, srcErrorMessages)
|
||||
import NameCache
|
||||
import TcRnTypes
|
||||
import System.IO
|
||||
import Foreign.ForeignPtr
|
||||
@ -127,6 +131,13 @@ hPutStringBuffer hdl (StringBuffer buf len cur)
|
||||
|
||||
#endif
|
||||
|
||||
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
|
||||
#if !MIN_GHC_API_VERSION(8,8,0)
|
||||
upNameCache ref upd_fn
|
||||
= atomicModifyIORef' ref upd_fn
|
||||
#else
|
||||
upNameCache = updNameCache
|
||||
#endif
|
||||
#if !MIN_GHC_API_VERSION(8,6,0)
|
||||
includePathsGlobal, includePathsQuote :: [String] -> [String]
|
||||
includePathsGlobal = id
|
||||
@ -288,7 +299,7 @@ instance Binary HieFile where
|
||||
data HieFileResult = HieFileResult { hie_file_result :: HieFile }
|
||||
|
||||
writeHieFile :: FilePath -> HieFile -> IO ()
|
||||
readHieFile :: NameCache -> FilePath -> IO (HieFileResult, ())
|
||||
readHieFile :: NameCacheUpdater -> FilePath -> IO HieFileResult
|
||||
supportsHieFiles :: Bool
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
@ -300,9 +311,8 @@ writeHieFile fp hie = do
|
||||
|
||||
readHieFile nc fp = do
|
||||
bh <- readBinMem fp
|
||||
nc' <- newIORef nc
|
||||
hie_file <- getWithUserData (NCU (atomicModifyIORef' nc')) bh
|
||||
return (HieFileResult hie_file, ())
|
||||
hie_file <- getWithUserData nc bh
|
||||
return (HieFileResult hie_file)
|
||||
|
||||
supportsHieFiles = True
|
||||
|
||||
|
@ -1548,6 +1548,15 @@ findDefinitionAndHoverTests :: TestTree
|
||||
findDefinitionAndHoverTests = let
|
||||
|
||||
tst (get, check) pos targetRange title = testSessionWithExtraFiles "hover" title $ \dir -> do
|
||||
|
||||
-- Dirty the cache to check that definitions work even in the presence of iface files
|
||||
liftIO $ runInDir dir $ do
|
||||
let fooPath = dir </> "Foo.hs"
|
||||
fooSource <- liftIO $ readFileUtf8 fooPath
|
||||
fooDoc <- createDoc fooPath "haskell" fooSource
|
||||
_ <- getHover fooDoc $ Position 4 3
|
||||
closeDoc fooDoc
|
||||
|
||||
doc <- openTestDataDoc (dir </> sourceFilePath)
|
||||
found <- get doc pos
|
||||
check found targetRange
|
||||
|
Loading…
Reference in New Issue
Block a user