...
 
Commits (3)
......@@ -67,6 +67,7 @@ import Text.ParserCombinators.ReadP (readP_to_S)
import GHC hiding (verbosity)
import GHC.Settings.Config
import GHC.Driver.Session hiding (projectVersion, verbosity)
import GHC.Driver.Backend
import GHC.Utils.Error
import GHC.Unit
import GHC.Utils.Panic (handleGhcException)
......@@ -495,9 +496,9 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do
let extra_opts | needHieFiles = [Opt_WriteHie, Opt_Haddock]
| otherwise = [Opt_Haddock]
dynflags' = (foldl' gopt_set dynflags extra_opts)
{ hscTarget = HscNothing
, ghcMode = CompManager
, ghcLink = NoLink
{ backend = NoBackend
, ghcMode = CompManager
, ghcLink = NoLink
}
flags' = filterRtsFlags flags
......
......@@ -240,7 +240,6 @@ classify tok =
ITcolumn_prag {} -> TkPragma
ITscc_prag {} -> TkPragma
ITgenerated_prag {} -> TkPragma
ITcore_prag {} -> TkPragma
ITunpack_prag {} -> TkPragma
ITnounpack_prag {} -> TkPragma
ITann_prag {} -> TkPragma
......@@ -381,7 +380,6 @@ inPragma False tok =
ITcolumn_prag {} -> True
ITscc_prag {} -> True
ITgenerated_prag {} -> True
ITcore_prag {} -> True
ITunpack_prag {} -> True
ITnounpack_prag {} -> True
ITann_prag {} -> True
......
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
......@@ -276,7 +277,7 @@ putName BinSymbolTable{
data BinSymbolTable = BinSymbolTable {
bin_symtab_next :: !FastMutInt, -- The next index to use
bin_symtab_map :: !(IORef (UniqFM (Int,Name)))
bin_symtab_map :: !(IORef (UniqFM Name (Int,Name)))
-- indexed by Name
}
......@@ -286,24 +287,24 @@ putFastString BinDictionary { bin_dict_next = j_r,
bin_dict_map = out_r} bh f
= do
out <- readIORef out_r
let unique = getUnique f
case lookupUFM out unique of
let !unique = getUnique f
case lookupUFM_Directly 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)
writeIORef out_r $! addToUFM_Directly out unique (j, f)
data BinDictionary = BinDictionary {
bin_dict_next :: !FastMutInt, -- The next index to use
bin_dict_map :: !(IORef (UniqFM (Int,FastString)))
bin_dict_map :: !(IORef (UniqFM FastString (Int,FastString)))
-- indexed by FastString
}
putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO ()
putSymbolTable bh next_off symtab = do
put_ bh next_off
let names = elems (array (0,next_off-1) (eltsUFM symtab))
......@@ -346,7 +347,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
}
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName :: BinHandle -> Name -> UniqFM Name (Int,Name) -> IO ()
serialiseName bh name _ = do
let modu = nameModule name
put_ bh (moduleUnit modu, moduleName modu, nameOccName name)
......