@@ -45,8 +45,6 @@ import MkIface
4545import NameCache
4646import StringBuffer as SB
4747import TidyPgm
48−import InstEnv
49−import FamInstEnv
5048import qualified GHC.LanguageExtensions as LangExt
5149
5250import Control.DeepSeq
@@ -139,16 +137,14 @@ typecheckModule
139137 :: IdeOptions
140138 -> ParsedModule
141139 -> HscEnv
142− -> UniqSupply
143140 -> [TcModuleResult]
144− -> [LoadPackageResult]
145141 -> ParsedModule
146142 -> IO ([FileDiagnostic], Maybe TcModuleResult)
147−typecheckModule opt mod packageState uniqSupply deps pkgs pm =
143+typecheckModule opt mod packageState deps pm =
148144 fmap (either (, Nothing) (second Just)) $ Ex.runExceptT $
149145 runGhcSessionExcept opt (Just mod) packageState $
150146 catchSrcErrors $ do
151− setupEnv uniqSupply deps pkgs
147+ setupEnv deps
152148 (warnings, tcm) <- withWarnings "Typechecker" $ \tweak ->
153149 GHC.typecheckModule pm{pm_mod_summary = tweak $ pm_mod_summary pm}
154150 tcm2 <- mkTcModuleResult (WriteInterface $ optWriteIface opt) tcm
@@ -158,23 +154,13 @@ typecheckModule opt mod packageState uniqSupply deps pkgs pm =
158154loadPackage ::
159155 IdeOptions
160156 -> HscEnv
161− -> UniqSupply
162− -> [LoadPackageResult]
163157 -> InstalledUnitId
164158 -> IO (Either [FileDiagnostic] LoadPackageResult)
165−loadPackage opt packageState us lps p =
159+loadPackage opt packageState p =
166160 Ex.runExceptT $
167161 runGhcSessionExcept opt Nothing packageState $
168162 catchSrcErrors $ do
169− setupEnv us [] lps
170− dflags <- hsc_dflags <$> getSession
171− exposedMods <- liftIO $ exposedModules <$> getPackage dflags p
172− let mods =
173− [ Module (DefiniteUnitId (DefUnitId p)) mod
174− | (mod, _mbParent) <- exposedMods
175− , False {- HLINT ignore "Short-circuited list comprehension" -}
176− ]
177− forM_ mods $ \mod -> GHC.getModuleInfo mod
163+ setupEnv []
178164 -- this populates the namecache and external package state
179165 session <- getSession
180166 modEnv <- nsNames <$> liftIO (readIORef $ hsc_NC session)
@@ -187,16 +173,14 @@ compileModule
187173 :: IdeOptions
188174 -> ParsedModule
189175 -> HscEnv
190− -> UniqSupply
191176 -> [TcModuleResult]
192− -> [LoadPackageResult]
193177 -> TcModuleResult
194178 -> IO ([FileDiagnostic], Maybe GhcModule)
195−compileModule opt mod packageState uniqSupply deps pkgs tmr =
179+compileModule opt mod packageState deps tmr =
196180 fmap (either (, Nothing) (second Just)) $ Ex.runExceptT $
197181 runGhcSessionExcept opt (Just mod) packageState $
198182 catchSrcErrors $ do
199− setupEnv uniqSupply (deps ++ [tmr]) pkgs
183+ setupEnv (deps ++ [tmr])
200184
201185 let tm = tmrModule tmr
202186 session <- getSession
@@ -259,29 +243,6 @@ moduleImportPaths pm
259243 rootModDir = takeDirectory . moduleNameSlashes . GHC.moduleName $ mod'
260244
261245
262−-- When we make a fresh GHC environment, the OrigNameCache comes already partially
263−-- populated. So to be safe, we simply extend this one.
264−mkNameCache :: GhcMonad m => UniqSupply -> [TcModuleResult] -> [LoadPackageResult] -> m NameCache
265−mkNameCache uniqSupply tms pkgs = do
266− session <- getSession
267− onc <- nsNames <$> liftIO (readIORef $ hsc_NC session)
268− return NameCache
269− { nsUniqs = uniqSupply
270− , nsNames = extendOrigNameCache' onc tms pkgs
271− }
272−
273−-- | Extend the name cache with the names from the typechecked home modules and the loaded packages.
274−-- If we have two environments containing the same module we take the later one. We do this because
275−-- the name cache comes prepopulated with modules from daml-prim and we overwrite those with our own
276−-- daml-prim package.
277−extendOrigNameCache' :: OrigNameCache -> [TcModuleResult] -> [LoadPackageResult] -> OrigNameCache
278−extendOrigNameCache' onc tms pkgs = foldl (plusModuleEnv_C (\_x y -> y)) onc modEnvs
279− where
280− modEnvs =
281− mkModuleEnv
282− [(ms_mod $ tcModSummary $ tmrModule tm, tmrOccEnvName tm) | tm <- tms] :
283− [lprModuleEnv lm | lm <- pkgs]
284−
285246newtype WriteInterface = WriteInterface Bool
286247
287248mkTcModuleResult
@@ -319,8 +280,8 @@ tcModSummary = pm_mod_summary . tm_parsed_module
319280
320281-- | Setup the environment that GHC needs according to our
321282-- best understanding (!)
322−setupEnv :: GhcMonad m => UniqSupply -> [TcModuleResult] -> [LoadPackageResult] -> m ()
323−setupEnv uniqSupply tms lps = do
283+setupEnv :: GhcMonad m => [TcModuleResult] -> m ()
284+setupEnv tms = do
324285 session <- getSession
325286
326287 let mss = map (pm_mod_summary . tm_parsed_module . tmrModule) tms
@@ -337,64 +298,9 @@ setupEnv uniqSupply tms lps = do
337298 foldl' (\fc (im, ifr) -> GHC.extendInstalledModuleEnv fc im ifr) fc
338299 $ zip ims ifrs
339300
340− when False $ do
341− -- construct a new NameCache
342− nc' <- mkNameCache uniqSupply tms lps
343− -- update the name cache
344− liftIO $ modifyIORef (hsc_NC session) $ const nc'
345− -- update the external package state
346− liftIO $ modifyIORef (hsc_EPS session) (updateEps lps)
347301 -- load dependent modules, which must be in topological order.
348302 mapM_ loadModuleHome tms
349303
350−-- | Update the external package state given the loaded package results.
351−updateEps :: [LoadPackageResult] -> ExternalPackageState -> ExternalPackageState
352−updateEps lps eps =
353− eps
354− { eps_inst_env = newInstEnv
355− , eps_PIT = newPIT
356− , eps_PTE = newPTE
357− , eps_rule_base = newRuleBase
358− , eps_complete_matches = newCompleteMatches
359− , eps_fam_inst_env = newFamInst
360− , eps_ann_env = newAnnEnv
361− , eps_mod_fam_inst_env = newModFamInstEnv
362− }
363− where
364− (newInstEnv, (newPIT, (newPTE, (newRuleBase, (newCompleteMatches, (newFamInst, (newAnnEnv, newModFamInstEnv))))))) =
365− foldl
366− (\(instEnv, (pit, (pte, (ruleBase, (completeMatches, (famInst, (annEnv, modFamInstEnv))))))) ->
367− (instEnv `extendInstEnvList0`) ***
368− (pit `plusModuleEnv`) ***
369− (pte `plusTypeEnv`) ***
370− (ruleBase `unionRuleBase`) ***
371− (completeMatches `extendCompleteMatchMap`) ***
372− (famInst `extendFamInstEnvList`) ***
373− (annEnv `plusAnnEnv`) *** (modFamInstEnv `plusModuleEnv`))
374− ( emptyInstEnv
375− , ( emptyPackageIfaceTable
376− , ( emptyTypeEnv
377− , ( emptyRuleBase
378− , (emptyUFM, (emptyFamInstEnv, (emptyAnnEnv, emptyModuleEnv)))))))
379− [ ( instEnvElts $ eps_inst_env e
380− , ( eps_PIT e
381− , ( eps_PTE e
382− , ( eps_rule_base e
383− , ( concat $ eltsUFM $ eps_complete_matches e
384− , ( famInstEnvElts $ eps_fam_inst_env e
385− , (eps_ann_env e, eps_mod_fam_inst_env e)))))))
386− | p <- lps
387− , let e = lprEps p
388− ]
389−
390− -- TODO (drsk): This is necessary because the EPS that we store include the results of
391− -- previously loaded packages and we end up adding instances several times to the environment.
392− -- It would be better to have pure delta stored in the LoadPackageResult, such that it
393− -- contains only identities/instances/names coming from that specific loaded package, but I
394− -- failed so far in computing the correct delta.
395− extendInstEnvList0 instEnv0 clsInsts =
396− extendInstEnvList emptyInstEnv $
397− nubOrdOn is_dfun_name $ instEnvElts instEnv0 ++ clsInsts
398304
399305-- | Load a module, quickly. Input doesn't need to be desugared.
400306-- A module must be loaded before dependent modules can be typechecked.