on 96778ea help sign in
src/Development/IDE/Core/Compile.hs+25−5
since splitsnapshots
unifiedsplit
@@ -46,6 +46,9 @@ import Control.Monad.Trans.Except
46import Data.Function
46import Data.Function
47import Data.Ord
47import Data.Ord
48import qualified Data.Text as T
48import qualified Data.Text as T
49+import qualified Data.Text.IO as T
50+import System.IO
51+import System.Time.Extra
49import Data.IORef
52import Data.IORef
50import Data.List.Extra
53import Data.List.Extra
51import Data.Maybe
54import Data.Maybe
@@ -107,21 +110,37 @@ compileModule
107 -> TcModuleResult
110 -> TcModuleResult
108 -> IO ([FileDiagnostic], Maybe CoreModule)
111 -> IO ([FileDiagnostic], Maybe CoreModule)
109compileModule packageState deps tmr =
112compileModule packageState deps tmr =
110− fmap (either (, Nothing) (second Just)) $
113+ fmap (either (, Nothing) (second Just)) $ do
114+ timer <- liftIO offsetTime
111− runGhcEnv packageState $
115+ runGhcEnv packageState $ do
116+ time <- liftIO timer
117+ liftIO $ T.hPutStrLn stderr $ T.pack $ "Entering GHC env: " <> show time
112 catchSrcErrors "compile" $ do
118 catchSrcErrors "compile" $ do
119+ timer <- liftIO offsetTime
113 setupEnv (deps ++ [tmr])
120 setupEnv (deps ++ [tmr])
121+ time <- liftIO timer
122+ liftIO $ T.hPutStrLn stderr $ T.pack $ "setupEnv: " <> show time
114
123
115 let tm = tmrModule tmr
124 let tm = tmrModule tmr
116 session <- getSession
125 session <- getSession
126+ timer <- liftIO offsetTime
117 (warnings,desugar) <- withWarnings "compile" $ \tweak -> do
127 (warnings,desugar) <- withWarnings "compile" $ \tweak -> do
128+ time <- liftIO timer
129+ liftIO $ T.hPutStrLn stderr $ T.pack $ "withWarnings: " <> show time
118 let pm = tm_parsed_module tm
130 let pm = tm_parsed_module tm
119 let pm' = pm{pm_mod_summary = tweak $ pm_mod_summary pm}
131 let pm' = pm{pm_mod_summary = tweak $ pm_mod_summary pm}
120 let tm' = tm{tm_parsed_module = pm'}
132 let tm' = tm{tm_parsed_module = pm'}
133+ timer <- liftIO offsetTime
121− GHC.dm_core_module <$> GHC.desugarModule tm'
134+ r <- GHC.dm_core_module <$> GHC.desugarModule tm'
135+ time <- liftIO timer
136+ liftIO $ T.hPutStrLn stderr $ T.pack $ "desugarModule: " <> show time
137+ pure r
122
138
123 -- give variables unique OccNames
139 -- give variables unique OccNames
140+ timer <- liftIO offsetTime
124 (tidy, details) <- liftIO $ tidyProgram session desugar
141 (tidy, details) <- liftIO $ tidyProgram session desugar
142+ time <- liftIO timer
143+ liftIO $ T.hPutStrLn stderr $ T.pack $ "tidyProgram: " <> show time
125
144
126 let core = CoreModule
145 let core = CoreModule
127 (cg_module tidy)
146 (cg_module tidy)
@@ -203,8 +222,9 @@ setupEnv tmsIn = do
203 foldl'
222 foldl'
204 (\fc (im, ifr) -> GHC.extendInstalledModuleEnv fc im ifr) prevFinderCache
223 (\fc (im, ifr) -> GHC.extendInstalledModuleEnv fc im ifr) prevFinderCache
205 $ zip ims ifrs
224 $ zip ims ifrs
225+ liftIO $ writeIORef (hsc_FC session) newFinderCache
206− newFinderCacheVar <- liftIO $ newIORef $! newFinderCache
226+ -- newFinderCacheVar <- liftIO $ newIORef $! newFinderCache
207− modifySession $ \s -> s { hsc_FC = newFinderCacheVar }
227+ -- modifySession $ \s -> s { hsc_FC = prevFinderCache }
208
228
209 -- load dependent modules, which must be in topological order.
229 -- load dependent modules, which must be in topological order.
210 mapM_ loadModuleHome tms
230 mapM_ loadModuleHome tms