@@ -30,11 +30,52 @@ module Development.IDE.Core.Compile
3030 , loadModulesHome
3131 , getDocsBatch
3232 , lookupName
33- ,mergeEnvs ) where
33+ , mergeEnvs
34+ ) where
3435
36+ import Control.Concurrent.Extra
37+ import Control.Concurrent.STM.Stats hiding (orElse )
38+ import Control.DeepSeq (force , liftRnf , rnf , rwhnf )
39+ import Control.Exception (evaluate )
40+ import Control.Exception.Safe
41+ import Control.Lens hiding (List )
42+ import Control.Monad.Except
43+ import Control.Monad.Extra
44+ import Control.Monad.Trans.Except
45+ import Data.Aeson (toJSON )
46+ import Data.Bifunctor (first , second )
47+ import Data.Binary
48+ import qualified Data.Binary as B
49+ import qualified Data.ByteString as BS
50+ import qualified Data.ByteString.Lazy as LBS
51+ import Data.Coerce
52+ import qualified Data.DList as DL
53+ import Data.Functor
54+ import qualified Data.HashMap.Strict as HashMap
55+ import Data.IORef
56+ import Data.IntMap (IntMap )
57+ import qualified Data.IntMap.Strict as IntMap
58+ import Data.List.Extra
59+ import Data.Map (Map )
60+ import qualified Data.Map.Strict as Map
61+ import Data.Maybe
62+ import qualified Data.Text as T
63+ import Data.Time (UTCTime (.. ),
64+ getCurrentTime )
65+ import Data.Time.Clock.POSIX (posixSecondsToUTCTime )
66+ import Data.Tuple.Extra (dupe )
67+ import Data.Unique as Unique
68+ import Debug.Trace
3569import Development.IDE.Core.Preprocessor
3670import Development.IDE.Core.RuleTypes
3771import Development.IDE.Core.Shake
72+ import Development.IDE.Core.Tracing (withTrace )
73+ import Development.IDE.GHC.Compat hiding (loadInterface ,
74+ parseHeader , parseModule ,
75+ tcRnModule , writeHieFile )
76+ import qualified Development.IDE.GHC.Compat as Compat
77+ import qualified Development.IDE.GHC.Compat as GHC
78+ import qualified Development.IDE.GHC.Compat.Util as Util
3879import Development.IDE.GHC.Error
3980import Development.IDE.GHC.Orphans ()
4081import Development.IDE.GHC.Util
@@ -43,94 +84,43 @@ import Development.IDE.Spans.Common
4384import Development.IDE.Types.Diagnostics
4485import Development.IDE.Types.Location
4586import Development.IDE.Types.Options
46-
47- import Development.IDE.GHC.Compat hiding (loadInterface ,
48- parseHeader , parseModule ,
49- tcRnModule , writeHieFile )
50- import qualified Development.IDE.GHC.Compat as Compat
51- import qualified Development.IDE.GHC.Compat as GHC
52- import qualified Development.IDE.GHC.Compat.Util as Util
53-
87+ import GHC (ForeignHValue ,
88+ GetDocsFailure (.. ),
89+ mgModSummaries ,
90+ parsedSource )
91+ import qualified GHC.LanguageExtensions as LangExt
92+ import GHC.Serialized
5493import HieDb
55-
94+ import qualified Language.LSP.Server as LSP
5695import Language.LSP.Types (DiagnosticTag (.. ))
57-
58- import Control.DeepSeq (force , liftRnf , rnf , rwhnf )
96+ import qualified Language.LSP.Types as LSP
97+ import System.Directory
98+ import System.FilePath
99+ import System.IO.Extra (fixIO , newTempFileWithin )
100+ import Unsafe.Coerce
59101
60102#if !MIN_VERSION_ghc(8,10,0)
61103import ErrUtils
62104#endif
63105
64-
65106#if MIN_VERSION_ghc(9,0,1)
66107import GHC.Tc.Gen.Splice
67108#else
68109import TcSplice
69110#endif
70111
71112#if MIN_VERSION_ghc(9,2,0)
72- import qualified GHC.Types.Error as Error
73- import qualified GHC as G
74- #endif
75-
76- import Control.Exception (evaluate )
77- import Control.Exception.Safe
78- import Control.Lens hiding (List )
79- import Control.Monad.Except
80- import Control.Monad.Extra
81- import Control.Monad.Trans.Except
82- import Data.Bifunctor (first , second )
83- import qualified Data.ByteString as BS
84- import qualified Data.DList as DL
85- import Data.IORef
86- import qualified Data.IntMap.Strict as IntMap
87- import Data.List.Extra
88- import qualified Data.Map.Strict as Map
89- import Data.Maybe
90- import qualified Data.Text as T
91- import Data.Time (UTCTime (.. ), getCurrentTime )
92- import qualified GHC.LanguageExtensions as LangExt
93- import System.Directory
94- import System.FilePath
95- import System.IO.Extra (fixIO , newTempFileWithin )
96-
97- -- GHC API imports
98- -- GHC API imports
99- #if MIN_VERSION_ghc(9,2,0)
113+ import Development.IDE.GHC.Compat.Util (emptyUDFM , fsLit ,
114+ plusUDFM_C )
100115import GHC (Anchor (anchor ),
101116 EpaComment (EpaComment ),
102117 EpaCommentTok (EpaBlockComment , EpaLineComment ),
103118 epAnnComments ,
104119 priorComments )
120+ import qualified GHC as G
105121import GHC.Hs (LEpaComment )
122+ import qualified GHC.Types.Error as Error
106123#endif
107- import GHC (GetDocsFailure (.. ),
108- mgModSummaries ,
109- parsedSource , ForeignHValue )
110-
111- import Control.Concurrent.Extra
112- import Control.Concurrent.STM.Stats hiding (orElse )
113- import Data.Aeson (toJSON )
114- import Data.Binary
115- import Data.Coerce
116- import Data.Functor
117- import qualified Data.HashMap.Strict as HashMap
118- import Data.IntMap (IntMap )
119- import Data.Map (Map )
120- import Data.Tuple.Extra (dupe )
121- import Data.Unique as Unique
122- import Development.IDE.Core.Tracing (withTrace )
123- import Development.IDE.GHC.Compat.Util (emptyUDFM , plusUDFM_C , fsLit )
124- import qualified Language.LSP.Server as LSP
125- import qualified Language.LSP.Types as LSP
126- import Unsafe.Coerce
127- import Data.Time.Clock.POSIX (posixSecondsToUTCTime )
128- import Debug.Trace
129-
130- import GHC.Serialized
131- import qualified Data.Binary as B
132- import Data.ByteString (ByteString )
133- import qualified Data.ByteString.Lazy as LBS
134124
135125-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
136126parseModule
@@ -159,7 +149,7 @@ computePackageDeps env pkg = do
159149
160150typecheckModule :: IdeDefer
161151 -> HscEnv
162- -> ( ModuleEnv UTCTime ) -- ^ linkables not to unload
152+ -> ModuleEnv UTCTime -- ^ linkables not to unload
163153 -> ParsedModule
164154 -> IO (IdeResult TcModuleResult )
165155typecheckModule (IdeDefer defer) hsc keep_lbls pm = do
@@ -310,7 +300,11 @@ captureSplicesAndDeps env k = do
310300 pure $ f aw'
311301
312302
313- tcRnModule :: HscEnv -> ModuleEnv UTCTime -> ParsedModule -> IO TcModuleResult
303+ tcRnModule
304+ :: HscEnv
305+ -> ModuleEnv UTCTime -- ^ Program linkables not to unload
306+ -> ParsedModule
307+ -> IO TcModuleResult
314308tcRnModule hsc_env keep_lbls pmod = do
315309 let ms = pm_mod_summary pmod
316310 hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) hsc_env
@@ -341,6 +335,7 @@ tcRnModule hsc_env keep_lbls pmod = do
341335 | mod_info <- eltsUDFM $ udfmIntersectUFM hpt (getUniqSet new)]
342336
343337 -- The linkables we depend on at runtime are the transitive closure of 'mods'
338+ -- restricted to the home package
344339 mod_env = filterModuleEnv (\ m _ -> elementOfUniqSet (moduleName m) mods_transitive) keep_lbls -- Could use restrictKeys if the constructors were exported
345340
346341 -- Serialize mod_env so we can read it from the interface
@@ -1086,7 +1081,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
10861081 Just ver -> pure $ Just ver
10871082 Nothing -> get_file_version $ toNormalizedFilePath' $ case linkableNeeded of
10881083 Just ObjectLinkable -> ml_obj_file (ms_location ms)
1089- _ -> ml_hi_file (ms_location ms)
1084+ _ -> ml_hi_file (ms_location ms)
10901085
10911086 -- The source is modified if it is newer than the destination
10921087 let sourceMod = case mb_dest_version of
@@ -1133,15 +1128,14 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
11331128 Just disk_obj_version@ (ModificationTime t) ->
11341129 -- If we make it this far, assume that the object code on disk is up to date
11351130 -- This assertion works because of the sourceMod check
1136- assert (disk_obj_version >= source_version)
1131+ assert (disk_obj_version >= source_version)
11371132 (UpToDate , Just $ LM (posixSecondsToUTCTime t) mod [DotO obj_file])
11381133 Just (VFSVersion _) -> error " object code in vfs"
11391134
11401135 let do_regenerate _reason = withTrace " regenerate interface" $ \ setTag -> do
1141- setTag " Module" $ moduleNameString $ moduleName $ mod
1136+ setTag " Module" $ moduleNameString $ moduleName mod
11421137 setTag " Reason" $ showReason _reason
11431138 liftIO $ traceMarkerIO $ " regenerate interface " ++ show (moduleNameString $ moduleName mod , showReason _reason)
1144- liftIO $ traceIO $ " regenerate interface " ++ show (moduleNameString $ moduleName mod , showReason _reason)
11451139 regenerate linkableNeeded
11461140
11471141 case (mb_checked_iface, recomp_iface_reqd <> recomp_obj_reqd) of
0 commit comments