PageRenderTime 40ms CodeModel.GetById 28ms RepoModel.GetById 1ms app.codeStats 1ms

/compiler/main/HscTypes.hs

http://github.com/ghc/ghc
Haskell | 2903 lines | 1394 code | 371 blank | 1138 comment | 22 complexity | 44b3ff6530491897c9c42f3695c3acc6 MD5 | raw file
Possible License(s): MIT, BSD-3-Clause, GPL-3.0
  1. {-
  2. (c) The University of Glasgow, 2006
  3. \section[HscTypes]{Types for the per-module compiler}
  4. -}
  5. {-# LANGUAGE CPP, ScopedTypeVariables #-}
  6. -- | Types for the per-module compiler
  7. module HscTypes (
  8. -- * compilation state
  9. HscEnv(..), hscEPS,
  10. FinderCache, FindResult(..),
  11. Target(..), TargetId(..), pprTarget, pprTargetId,
  12. ModuleGraph, emptyMG,
  13. HscStatus(..),
  14. #ifdef GHCI
  15. IServ(..),
  16. #endif
  17. -- * Hsc monad
  18. Hsc(..), runHsc, runInteractiveHsc,
  19. -- * Information about modules
  20. ModDetails(..), emptyModDetails,
  21. ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
  22. ImportedMods, ImportedModsVal(..),
  23. ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary,
  24. msHsFilePath, msHiFilePath, msObjFilePath,
  25. SourceModified(..),
  26. -- * Information about the module being compiled
  27. -- (re-exported from DriverPhases)
  28. HscSource(..), isHsBootOrSig, hscSourceString,
  29. -- * State relating to modules in this package
  30. HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
  31. lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
  32. addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
  33. hptInstances, hptRules, hptVectInfo, pprHPT,
  34. hptObjs,
  35. -- * State relating to known packages
  36. ExternalPackageState(..), EpsStats(..), addEpsInStats,
  37. PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
  38. lookupIfaceByModule, emptyModIface, lookupHptByModule,
  39. PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
  40. mkSOName, mkHsSOName, soExt,
  41. -- * Metaprogramming
  42. MetaRequest(..),
  43. MetaResult, -- data constructors not exported to ensure correct response type
  44. metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,
  45. MetaHook,
  46. -- * Annotations
  47. prepareAnnotations,
  48. -- * Interactive context
  49. InteractiveContext(..), emptyInteractiveContext,
  50. icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
  51. extendInteractiveContext, extendInteractiveContextWithIds,
  52. substInteractiveContext,
  53. setInteractivePrintName, icInteractiveModule,
  54. InteractiveImport(..), setInteractivePackage,
  55. mkPrintUnqualified, pprModulePrefix,
  56. mkQualPackage, mkQualModule, pkgQual,
  57. -- * Interfaces
  58. ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
  59. emptyIfaceWarnCache, mi_boot, mi_fix,
  60. -- * Fixity
  61. FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
  62. -- * TyThings and type environments
  63. TyThing(..), tyThingAvailInfo,
  64. tyThingTyCon, tyThingDataCon,
  65. tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,
  66. implicitTyThings, implicitTyConThings, implicitClassThings,
  67. isImplicitTyThing,
  68. TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
  69. typeEnvFromEntities, mkTypeEnvWithImplicits,
  70. extendTypeEnv, extendTypeEnvList,
  71. extendTypeEnvWithIds, plusTypeEnv,
  72. lookupTypeEnv,
  73. typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
  74. typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
  75. -- * MonadThings
  76. MonadThings(..),
  77. -- * Information on imports and exports
  78. WhetherHasOrphans, IsBootInterface, Usage(..),
  79. Dependencies(..), noDependencies,
  80. NameCache(..), OrigNameCache, updNameCacheIO,
  81. IfaceExport,
  82. -- * Warnings
  83. Warnings(..), WarningTxt(..), plusWarns,
  84. -- * Linker stuff
  85. Linkable(..), isObjectLinkable, linkableObjs,
  86. Unlinked(..), CompiledByteCode,
  87. isObject, nameOfObject, isInterpretable, byteCodeOfObject,
  88. -- * Program coverage
  89. HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
  90. -- * Breakpoints
  91. ModBreaks (..), emptyModBreaks,
  92. -- * Vectorisation information
  93. VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
  94. noIfaceVectInfo, isNoIfaceVectInfo,
  95. -- * Safe Haskell information
  96. IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
  97. trustInfoToNum, numToTrustInfo, IsSafeImport,
  98. -- * result of the parser
  99. HsParsedModule(..),
  100. -- * Compilation errors and warnings
  101. SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
  102. throwOneError, handleSourceError,
  103. handleFlagWarnings, printOrThrowWarnings,
  104. ) where
  105. #include "HsVersions.h"
  106. #ifdef GHCI
  107. import ByteCodeTypes
  108. import InteractiveEvalTypes ( Resume )
  109. import GHCi.Message ( Pipe )
  110. import GHCi.RemoteTypes
  111. #endif
  112. import UniqFM
  113. import HsSyn
  114. import RdrName
  115. import Avail
  116. import Module
  117. import InstEnv ( InstEnv, ClsInst, identicalClsInstHead )
  118. import FamInstEnv
  119. import CoreSyn ( CoreProgram, RuleBase )
  120. import Name
  121. import NameEnv
  122. import NameSet
  123. import VarEnv
  124. import VarSet
  125. import Var
  126. import Id
  127. import IdInfo ( IdDetails(..), RecSelParent(..))
  128. import Type
  129. import ApiAnnotation ( ApiAnns )
  130. import Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
  131. import Class
  132. import TyCon
  133. import CoAxiom
  134. import ConLike
  135. import DataCon
  136. import PatSyn
  137. import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
  138. , eqTyConName )
  139. import TysWiredIn
  140. import Packages hiding ( Version(..) )
  141. import DynFlags
  142. import DriverPhases ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
  143. import BasicTypes
  144. import IfaceSyn
  145. import CoreSyn ( CoreRule, CoreVect )
  146. import Maybes
  147. import Outputable
  148. import SrcLoc
  149. import Unique
  150. import UniqDFM
  151. import UniqSupply
  152. import FastString
  153. import StringBuffer ( StringBuffer )
  154. import Fingerprint
  155. import MonadUtils
  156. import Bag
  157. import Binary
  158. import ErrUtils
  159. import Platform
  160. import Util
  161. import GHC.Serialized ( Serialized )
  162. import Foreign
  163. import Control.Monad ( guard, liftM, when, ap )
  164. import Data.IORef
  165. import Data.Time
  166. import Exception
  167. import System.FilePath
  168. #ifdef GHCI
  169. import Control.Concurrent
  170. import System.Process ( ProcessHandle )
  171. #endif
  172. -- -----------------------------------------------------------------------------
  173. -- Compilation state
  174. -- -----------------------------------------------------------------------------
  175. -- | Status of a compilation to hard-code
  176. data HscStatus
  177. = HscNotGeneratingCode
  178. | HscUpToDate
  179. | HscUpdateBoot
  180. | HscUpdateSig
  181. | HscRecomp CgGuts ModSummary
  182. -- -----------------------------------------------------------------------------
  183. -- The Hsc monad: Passing an environment and warning state
  184. newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))
  185. instance Functor Hsc where
  186. fmap = liftM
  187. instance Applicative Hsc where
  188. pure a = Hsc $ \_ w -> return (a, w)
  189. (<*>) = ap
  190. instance Monad Hsc where
  191. Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w
  192. case k a of
  193. Hsc k' -> k' e w1
  194. instance MonadIO Hsc where
  195. liftIO io = Hsc $ \_ w -> do a <- io; return (a, w)
  196. instance HasDynFlags Hsc where
  197. getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)
  198. runHsc :: HscEnv -> Hsc a -> IO a
  199. runHsc hsc_env (Hsc hsc) = do
  200. (a, w) <- hsc hsc_env emptyBag
  201. printOrThrowWarnings (hsc_dflags hsc_env) w
  202. return a
  203. runInteractiveHsc :: HscEnv -> Hsc a -> IO a
  204. -- A variant of runHsc that switches in the DynFlags from the
  205. -- InteractiveContext before running the Hsc computation.
  206. runInteractiveHsc hsc_env
  207. = runHsc (hsc_env { hsc_dflags = interactive_dflags })
  208. where
  209. interactive_dflags = ic_dflags (hsc_IC hsc_env)
  210. -- -----------------------------------------------------------------------------
  211. -- Source Errors
  212. -- When the compiler (HscMain) discovers errors, it throws an
  213. -- exception in the IO monad.
  214. mkSrcErr :: ErrorMessages -> SourceError
  215. mkSrcErr = SourceError
  216. srcErrorMessages :: SourceError -> ErrorMessages
  217. srcErrorMessages (SourceError msgs) = msgs
  218. mkApiErr :: DynFlags -> SDoc -> GhcApiError
  219. mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
  220. throwOneError :: MonadIO m => ErrMsg -> m ab
  221. throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err
  222. -- | A source error is an error that is caused by one or more errors in the
  223. -- source code. A 'SourceError' is thrown by many functions in the
  224. -- compilation pipeline. Inside GHC these errors are merely printed via
  225. -- 'log_action', but API clients may treat them differently, for example,
  226. -- insert them into a list box. If you want the default behaviour, use the
  227. -- idiom:
  228. --
  229. -- > handleSourceError printExceptionAndWarnings $ do
  230. -- > ... api calls that may fail ...
  231. --
  232. -- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
  233. -- This list may be empty if the compiler failed due to @-Werror@
  234. -- ('Opt_WarnIsError').
  235. --
  236. -- See 'printExceptionAndWarnings' for more information on what to take care
  237. -- of when writing a custom error handler.
  238. newtype SourceError = SourceError ErrorMessages
  239. instance Show SourceError where
  240. show (SourceError msgs) = unlines . map show . bagToList $ msgs
  241. instance Exception SourceError
  242. -- | Perform the given action and call the exception handler if the action
  243. -- throws a 'SourceError'. See 'SourceError' for more information.
  244. handleSourceError :: (ExceptionMonad m) =>
  245. (SourceError -> m a) -- ^ exception handler
  246. -> m a -- ^ action to perform
  247. -> m a
  248. handleSourceError handler act =
  249. gcatch act (\(e :: SourceError) -> handler e)
  250. -- | An error thrown if the GHC API is used in an incorrect fashion.
  251. newtype GhcApiError = GhcApiError String
  252. instance Show GhcApiError where
  253. show (GhcApiError msg) = msg
  254. instance Exception GhcApiError
  255. -- | Given a bag of warnings, turn them into an exception if
  256. -- -Werror is enabled, or print them out otherwise.
  257. printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
  258. printOrThrowWarnings dflags warns
  259. | gopt Opt_WarnIsError dflags
  260. = when (not (isEmptyBag warns)) $ do
  261. throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
  262. | otherwise
  263. = printBagOfErrors dflags warns
  264. handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
  265. handleFlagWarnings dflags warns
  266. = when (wopt Opt_WarnDeprecatedFlags dflags) $ do
  267. -- It would be nicer if warns :: [Located MsgDoc], but that
  268. -- has circular import problems.
  269. let bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
  270. | L loc warn <- warns ]
  271. printOrThrowWarnings dflags bag
  272. {-
  273. ************************************************************************
  274. * *
  275. \subsection{HscEnv}
  276. * *
  277. ************************************************************************
  278. -}
  279. -- | HscEnv is like 'Session', except that some of the fields are immutable.
  280. -- An HscEnv is used to compile a single module from plain Haskell source
  281. -- code (after preprocessing) to either C, assembly or C--. Things like
  282. -- the module graph don't change during a single compilation.
  283. --
  284. -- Historical note: \"hsc\" used to be the name of the compiler binary,
  285. -- when there was a separate driver and compiler. To compile a single
  286. -- module, the driver would invoke hsc on the source code... so nowadays
  287. -- we think of hsc as the layer of the compiler that deals with compiling
  288. -- a single module.
  289. data HscEnv
  290. = HscEnv {
  291. hsc_dflags :: DynFlags,
  292. -- ^ The dynamic flag settings
  293. hsc_targets :: [Target],
  294. -- ^ The targets (or roots) of the current session
  295. hsc_mod_graph :: ModuleGraph,
  296. -- ^ The module graph of the current session
  297. hsc_IC :: InteractiveContext,
  298. -- ^ The context for evaluating interactive statements
  299. hsc_HPT :: HomePackageTable,
  300. -- ^ The home package table describes already-compiled
  301. -- home-package modules, /excluding/ the module we
  302. -- are compiling right now.
  303. -- (In one-shot mode the current module is the only
  304. -- home-package module, so hsc_HPT is empty. All other
  305. -- modules count as \"external-package\" modules.
  306. -- However, even in GHCi mode, hi-boot interfaces are
  307. -- demand-loaded into the external-package table.)
  308. --
  309. -- 'hsc_HPT' is not mutable because we only demand-load
  310. -- external packages; the home package is eagerly
  311. -- loaded, module by module, by the compilation manager.
  312. --
  313. -- The HPT may contain modules compiled earlier by @--make@
  314. -- but not actually below the current module in the dependency
  315. -- graph.
  316. --
  317. -- (This changes a previous invariant: changed Jan 05.)
  318. hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
  319. -- ^ Information about the currently loaded external packages.
  320. -- This is mutable because packages will be demand-loaded during
  321. -- a compilation run as required.
  322. hsc_NC :: {-# UNPACK #-} !(IORef NameCache),
  323. -- ^ As with 'hsc_EPS', this is side-effected by compiling to
  324. -- reflect sucking in interface files. They cache the state of
  325. -- external interface files, in effect.
  326. hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
  327. -- ^ The cached result of performing finding in the file system
  328. hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
  329. -- ^ Used for one-shot compilation only, to initialise
  330. -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
  331. -- 'TcRnTypes.TcGblEnv'
  332. #ifdef GHCI
  333. , hsc_iserv :: MVar (Maybe IServ)
  334. -- ^ interactive server process. Created the first
  335. -- time it is needed.
  336. #endif
  337. }
  338. #ifdef GHCI
  339. data IServ = IServ
  340. { iservPipe :: Pipe
  341. , iservProcess :: ProcessHandle
  342. , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  343. , iservPendingFrees :: [HValueRef]
  344. }
  345. #endif
  346. -- | Retrieve the ExternalPackageState cache.
  347. hscEPS :: HscEnv -> IO ExternalPackageState
  348. hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
  349. -- | A compilation target.
  350. --
  351. -- A target may be supplied with the actual text of the
  352. -- module. If so, use this instead of the file contents (this
  353. -- is for use in an IDE where the file hasn't been saved by
  354. -- the user yet).
  355. data Target
  356. = Target {
  357. targetId :: TargetId, -- ^ module or filename
  358. targetAllowObjCode :: Bool, -- ^ object code allowed?
  359. targetContents :: Maybe (StringBuffer,UTCTime)
  360. -- ^ in-memory text buffer?
  361. }
  362. data TargetId
  363. = TargetModule ModuleName
  364. -- ^ A module name: search for the file
  365. | TargetFile FilePath (Maybe Phase)
  366. -- ^ A filename: preprocess & parse it to find the module name.
  367. -- If specified, the Phase indicates how to compile this file
  368. -- (which phase to start from). Nothing indicates the starting phase
  369. -- should be determined from the suffix of the filename.
  370. deriving Eq
  371. pprTarget :: Target -> SDoc
  372. pprTarget (Target id obj _) =
  373. (if obj then char '*' else empty) <> pprTargetId id
  374. instance Outputable Target where
  375. ppr = pprTarget
  376. pprTargetId :: TargetId -> SDoc
  377. pprTargetId (TargetModule m) = ppr m
  378. pprTargetId (TargetFile f _) = text f
  379. instance Outputable TargetId where
  380. ppr = pprTargetId
  381. {-
  382. ************************************************************************
  383. * *
  384. \subsection{Package and Module Tables}
  385. * *
  386. ************************************************************************
  387. -}
  388. -- | Helps us find information about modules in the home package
  389. type HomePackageTable = DModuleNameEnv HomeModInfo
  390. -- Domain = modules in the home package that have been fully compiled
  391. -- "home" unit id cached here for convenience
  392. -- | Helps us find information about modules in the imported packages
  393. type PackageIfaceTable = ModuleEnv ModIface
  394. -- Domain = modules in the imported packages
  395. -- | Constructs an empty HomePackageTable
  396. emptyHomePackageTable :: HomePackageTable
  397. emptyHomePackageTable = emptyUDFM
  398. -- | Constructs an empty PackageIfaceTable
  399. emptyPackageIfaceTable :: PackageIfaceTable
  400. emptyPackageIfaceTable = emptyModuleEnv
  401. pprHPT :: HomePackageTable -> SDoc
  402. -- A bit aribitrary for now
  403. pprHPT hpt = pprUDFM hpt $ \hms ->
  404. vcat [ hang (ppr (mi_module (hm_iface hm)))
  405. 2 (ppr (md_types (hm_details hm)))
  406. | hm <- hms ]
  407. lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
  408. lookupHpt = lookupUDFM
  409. lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
  410. lookupHptDirectly = lookupUDFM_Directly
  411. eltsHpt :: HomePackageTable -> [HomeModInfo]
  412. eltsHpt = eltsUDFM
  413. filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
  414. filterHpt = filterUDFM
  415. allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
  416. allHpt = allUDFM
  417. mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
  418. mapHpt = mapUDFM
  419. delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
  420. delFromHpt = delFromUDFM
  421. addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
  422. addToHpt = addToUDFM
  423. addListToHpt
  424. :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
  425. addListToHpt = addListToUDFM
  426. listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
  427. listToHpt = listToUDFM
  428. lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
  429. -- The HPT is indexed by ModuleName, not Module,
  430. -- we must check for a hit on the right Module
  431. lookupHptByModule hpt mod
  432. = case lookupHpt hpt (moduleName mod) of
  433. Just hm | mi_module (hm_iface hm) == mod -> Just hm
  434. _otherwise -> Nothing
  435. -- | Information about modules in the package being compiled
  436. data HomeModInfo
  437. = HomeModInfo {
  438. hm_iface :: !ModIface,
  439. -- ^ The basic loaded interface file: every loaded module has one of
  440. -- these, even if it is imported from another package
  441. hm_details :: !ModDetails,
  442. -- ^ Extra information that has been created from the 'ModIface' for
  443. -- the module, typically during typechecking
  444. hm_linkable :: !(Maybe Linkable)
  445. -- ^ The actual artifact we would like to link to access things in
  446. -- this module.
  447. --
  448. -- 'hm_linkable' might be Nothing:
  449. --
  450. -- 1. If this is an .hs-boot module
  451. --
  452. -- 2. Temporarily during compilation if we pruned away
  453. -- the old linkable because it was out of date.
  454. --
  455. -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
  456. -- in the 'HomePackageTable' will be @Just@.
  457. --
  458. -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the
  459. -- 'HomeModInfo' by building a new 'ModDetails' from the old
  460. -- 'ModIface' (only).
  461. }
  462. -- | Find the 'ModIface' for a 'Module', searching in both the loaded home
  463. -- and external package module information
  464. lookupIfaceByModule
  465. :: DynFlags
  466. -> HomePackageTable
  467. -> PackageIfaceTable
  468. -> Module
  469. -> Maybe ModIface
  470. lookupIfaceByModule _dflags hpt pit mod
  471. = case lookupHptByModule hpt mod of
  472. Just hm -> Just (hm_iface hm)
  473. Nothing -> lookupModuleEnv pit mod
  474. -- If the module does come from the home package, why do we look in the PIT as well?
  475. -- (a) In OneShot mode, even home-package modules accumulate in the PIT
  476. -- (b) Even in Batch (--make) mode, there is *one* case where a home-package
  477. -- module is in the PIT, namely GHC.Prim when compiling the base package.
  478. -- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
  479. -- of its own, but it doesn't seem worth the bother.
  480. -- | Find all the instance declarations (of classes and families) from
  481. -- the Home Package Table filtered by the provided predicate function.
  482. -- Used in @tcRnImports@, to select the instances that are in the
  483. -- transitive closure of imports from the currently compiled module.
  484. hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
  485. hptInstances hsc_env want_this_module
  486. = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
  487. guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
  488. let details = hm_details mod_info
  489. return (md_insts details, md_fam_insts details)
  490. in (concat insts, concat famInsts)
  491. -- | Get the combined VectInfo of all modules in the home package table. In
  492. -- contrast to instances and rules, we don't care whether the modules are
  493. -- "below" us in the dependency sense. The VectInfo of those modules not "below"
  494. -- us does not affect the compilation of the current module.
  495. hptVectInfo :: HscEnv -> VectInfo
  496. hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
  497. -- | Get rules from modules "below" this one (in the dependency sense)
  498. hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
  499. hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
  500. -- | Get annotations from modules "below" this one (in the dependency sense)
  501. hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
  502. hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps
  503. hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
  504. hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
  505. hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
  506. -- | Get things from modules "below" this one (in the dependency sense)
  507. -- C.f Inst.hptInstances
  508. hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
  509. hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
  510. | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
  511. | otherwise
  512. = let hpt = hsc_HPT hsc_env
  513. in
  514. [ thing
  515. | -- Find each non-hi-boot module below me
  516. (mod, is_boot_mod) <- deps
  517. , include_hi_boot || not is_boot_mod
  518. -- unsavoury: when compiling the base package with --make, we
  519. -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't
  520. -- be in the HPT, because we never compile it; it's in the EPT
  521. -- instead. ToDo: clean up, and remove this slightly bogus filter:
  522. , mod /= moduleName gHC_PRIM
  523. -- Look it up in the HPT
  524. , let things = case lookupHpt hpt mod of
  525. Just info -> extract info
  526. Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
  527. msg = vcat [text "missing module" <+> ppr mod,
  528. text "Probable cause: out-of-date interface files"]
  529. -- This really shouldn't happen, but see Trac #962
  530. -- And get its dfuns
  531. , thing <- things ]
  532. hptObjs :: HomePackageTable -> [FilePath]
  533. hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsHpt hpt))
  534. {-
  535. ************************************************************************
  536. * *
  537. \subsection{Metaprogramming}
  538. * *
  539. ************************************************************************
  540. -}
  541. -- | The supported metaprogramming result types
  542. data MetaRequest
  543. = MetaE (LHsExpr RdrName -> MetaResult)
  544. | MetaP (LPat RdrName -> MetaResult)
  545. | MetaT (LHsType RdrName -> MetaResult)
  546. | MetaD ([LHsDecl RdrName] -> MetaResult)
  547. | MetaAW (Serialized -> MetaResult)
  548. -- | data constructors not exported to ensure correct result type
  549. data MetaResult
  550. = MetaResE { unMetaResE :: LHsExpr RdrName }
  551. | MetaResP { unMetaResP :: LPat RdrName }
  552. | MetaResT { unMetaResT :: LHsType RdrName }
  553. | MetaResD { unMetaResD :: [LHsDecl RdrName] }
  554. | MetaResAW { unMetaResAW :: Serialized }
  555. type MetaHook f = MetaRequest -> LHsExpr Id -> f MetaResult
  556. metaRequestE :: Functor f => MetaHook f -> LHsExpr Id -> f (LHsExpr RdrName)
  557. metaRequestE h = fmap unMetaResE . h (MetaE MetaResE)
  558. metaRequestP :: Functor f => MetaHook f -> LHsExpr Id -> f (LPat RdrName)
  559. metaRequestP h = fmap unMetaResP . h (MetaP MetaResP)
  560. metaRequestT :: Functor f => MetaHook f -> LHsExpr Id -> f (LHsType RdrName)
  561. metaRequestT h = fmap unMetaResT . h (MetaT MetaResT)
  562. metaRequestD :: Functor f => MetaHook f -> LHsExpr Id -> f [LHsDecl RdrName]
  563. metaRequestD h = fmap unMetaResD . h (MetaD MetaResD)
  564. metaRequestAW :: Functor f => MetaHook f -> LHsExpr Id -> f Serialized
  565. metaRequestAW h = fmap unMetaResAW . h (MetaAW MetaResAW)
  566. {-
  567. ************************************************************************
  568. * *
  569. \subsection{Dealing with Annotations}
  570. * *
  571. ************************************************************************
  572. -}
  573. -- | Deal with gathering annotations in from all possible places
  574. -- and combining them into a single 'AnnEnv'
  575. prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
  576. prepareAnnotations hsc_env mb_guts = do
  577. eps <- hscEPS hsc_env
  578. let -- Extract annotations from the module being compiled if supplied one
  579. mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts
  580. -- Extract dependencies of the module if we are supplied one,
  581. -- otherwise load annotations from all home package table
  582. -- entries regardless of dependency ordering.
  583. home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
  584. other_pkg_anns = eps_ann_env eps
  585. ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
  586. Just home_pkg_anns,
  587. Just other_pkg_anns]
  588. return ann_env
  589. {-
  590. ************************************************************************
  591. * *
  592. \subsection{The Finder cache}
  593. * *
  594. ************************************************************************
  595. -}
  596. -- | The 'FinderCache' maps modules to the result of
  597. -- searching for that module. It records the results of searching for
  598. -- modules along the search path. On @:load@, we flush the entire
  599. -- contents of this cache.
  600. --
  601. -- Although the @FinderCache@ range is 'FindResult' for convenience,
  602. -- in fact it will only ever contain 'Found' or 'NotFound' entries.
  603. --
  604. type FinderCache = ModuleEnv FindResult
  605. -- | The result of searching for an imported module.
  606. data FindResult
  607. = Found ModLocation Module
  608. -- ^ The module was found
  609. | NoPackage UnitId
  610. -- ^ The requested package was not found
  611. | FoundMultiple [(Module, ModuleOrigin)]
  612. -- ^ _Error_: both in multiple packages
  613. -- | Not found
  614. | NotFound
  615. { fr_paths :: [FilePath] -- Places where I looked
  616. , fr_pkg :: Maybe UnitId -- Just p => module is in this package's
  617. -- manifest, but couldn't find
  618. -- the .hi file
  619. , fr_mods_hidden :: [UnitId] -- Module is in these packages,
  620. -- but the *module* is hidden
  621. , fr_pkgs_hidden :: [UnitId] -- Module is in these packages,
  622. -- but the *package* is hidden
  623. , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
  624. }
  625. {-
  626. ************************************************************************
  627. * *
  628. \subsection{Symbol tables and Module details}
  629. * *
  630. ************************************************************************
  631. -}
  632. -- | A 'ModIface' plus a 'ModDetails' summarises everything we know
  633. -- about a compiled module. The 'ModIface' is the stuff *before* linking,
  634. -- and can be written out to an interface file. The 'ModDetails is after
  635. -- linking and can be completely recovered from just the 'ModIface'.
  636. --
  637. -- When we read an interface file, we also construct a 'ModIface' from it,
  638. -- except that we explicitly make the 'mi_decls' and a few other fields empty;
  639. -- as when reading we consolidate the declarations etc. into a number of indexed
  640. -- maps and environments in the 'ExternalPackageState'.
  641. data ModIface
  642. = ModIface {
  643. mi_module :: !Module, -- ^ Name of the module we are for
  644. mi_sig_of :: !(Maybe Module), -- ^ Are we a sig of another mod?
  645. mi_iface_hash :: !Fingerprint, -- ^ Hash of the whole interface
  646. mi_mod_hash :: !Fingerprint, -- ^ Hash of the ABI only
  647. mi_flag_hash :: !Fingerprint, -- ^ Hash of the important flags
  648. -- used when compiling this module
  649. mi_orphan :: !WhetherHasOrphans, -- ^ Whether this module has orphans
  650. mi_finsts :: !WhetherHasFamInst, -- ^ Whether this module has family instances
  651. mi_hsc_src :: !HscSource, -- ^ Boot? Signature?
  652. mi_deps :: Dependencies,
  653. -- ^ The dependencies of the module. This is
  654. -- consulted for directly-imported modules, but not
  655. -- for anything else (hence lazy)
  656. mi_usages :: [Usage],
  657. -- ^ Usages; kept sorted so that it's easy to decide
  658. -- whether to write a new iface file (changing usages
  659. -- doesn't affect the hash of this module)
  660. -- NOT STRICT! we read this field lazily from the interface file
  661. -- It is *only* consulted by the recompilation checker
  662. mi_exports :: ![IfaceExport],
  663. -- ^ Exports
  664. -- Kept sorted by (mod,occ), to make version comparisons easier
  665. -- Records the modules that are the declaration points for things
  666. -- exported by this module, and the 'OccName's of those things
  667. mi_exp_hash :: !Fingerprint,
  668. -- ^ Hash of export list
  669. mi_used_th :: !Bool,
  670. -- ^ Module required TH splices when it was compiled.
  671. -- This disables recompilation avoidance (see #481).
  672. mi_fixities :: [(OccName,Fixity)],
  673. -- ^ Fixities
  674. -- NOT STRICT! we read this field lazily from the interface file
  675. mi_warns :: Warnings,
  676. -- ^ Warnings
  677. -- NOT STRICT! we read this field lazily from the interface file
  678. mi_anns :: [IfaceAnnotation],
  679. -- ^ Annotations
  680. -- NOT STRICT! we read this field lazily from the interface file
  681. mi_decls :: [(Fingerprint,IfaceDecl)],
  682. -- ^ Type, class and variable declarations
  683. -- The hash of an Id changes if its fixity or deprecations change
  684. -- (as well as its type of course)
  685. -- Ditto data constructors, class operations, except that
  686. -- the hash of the parent class/tycon changes
  687. mi_globals :: !(Maybe GlobalRdrEnv),
  688. -- ^ Binds all the things defined at the top level in
  689. -- the /original source/ code for this module. which
  690. -- is NOT the same as mi_exports, nor mi_decls (which
  691. -- may contains declarations for things not actually
  692. -- defined by the user). Used for GHCi and for inspecting
  693. -- the contents of modules via the GHC API only.
  694. --
  695. -- (We need the source file to figure out the
  696. -- top-level environment, if we didn't compile this module
  697. -- from source then this field contains @Nothing@).
  698. --
  699. -- Strictly speaking this field should live in the
  700. -- 'HomeModInfo', but that leads to more plumbing.
  701. -- Instance declarations and rules
  702. mi_insts :: [IfaceClsInst], -- ^ Sorted class instance
  703. mi_fam_insts :: [IfaceFamInst], -- ^ Sorted family instances
  704. mi_rules :: [IfaceRule], -- ^ Sorted rules
  705. mi_orphan_hash :: !Fingerprint, -- ^ Hash for orphan rules, class and family
  706. -- instances, and vectorise pragmas combined
  707. mi_vect_info :: !IfaceVectInfo, -- ^ Vectorisation information
  708. -- Cached environments for easy lookup
  709. -- These are computed (lazily) from other fields
  710. -- and are not put into the interface file
  711. mi_warn_fn :: OccName -> Maybe WarningTxt,
  712. -- ^ Cached lookup for 'mi_warns'
  713. mi_fix_fn :: OccName -> Maybe Fixity,
  714. -- ^ Cached lookup for 'mi_fixities'
  715. mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
  716. -- ^ Cached lookup for 'mi_decls'.
  717. -- The @Nothing@ in 'mi_hash_fn' means that the thing
  718. -- isn't in decls. It's useful to know that when
  719. -- seeing if we are up to date wrt. the old interface.
  720. -- The 'OccName' is the parent of the name, if it has one.
  721. mi_hpc :: !AnyHpcUsage,
  722. -- ^ True if this program uses Hpc at any point in the program.
  723. mi_trust :: !IfaceTrustInfo,
  724. -- ^ Safe Haskell Trust information for this module.
  725. mi_trust_pkg :: !Bool
  726. -- ^ Do we require the package this module resides in be trusted
  727. -- to trust this module? This is used for the situation where a
  728. -- module is Safe (so doesn't require the package be trusted
  729. -- itself) but imports some trustworthy modules from its own
  730. -- package (which does require its own package be trusted).
  731. -- See Note [RnNames . Trust Own Package]
  732. }
  733. -- | Old-style accessor for whether or not the ModIface came from an hs-boot
  734. -- file.
  735. mi_boot :: ModIface -> Bool
  736. mi_boot iface = mi_hsc_src iface == HsBootFile
  737. -- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be
  738. -- found, 'defaultFixity' is returned instead.
  739. mi_fix :: ModIface -> OccName -> Fixity
  740. mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity
  741. instance Binary ModIface where
  742. put_ bh (ModIface {
  743. mi_module = mod,
  744. mi_sig_of = sig_of,
  745. mi_hsc_src = hsc_src,
  746. mi_iface_hash= iface_hash,
  747. mi_mod_hash = mod_hash,
  748. mi_flag_hash = flag_hash,
  749. mi_orphan = orphan,
  750. mi_finsts = hasFamInsts,
  751. mi_deps = deps,
  752. mi_usages = usages,
  753. mi_exports = exports,
  754. mi_exp_hash = exp_hash,
  755. mi_used_th = used_th,
  756. mi_fixities = fixities,
  757. mi_warns = warns,
  758. mi_anns = anns,
  759. mi_decls = decls,
  760. mi_insts = insts,
  761. mi_fam_insts = fam_insts,
  762. mi_rules = rules,
  763. mi_orphan_hash = orphan_hash,
  764. mi_vect_info = vect_info,
  765. mi_hpc = hpc_info,
  766. mi_trust = trust,
  767. mi_trust_pkg = trust_pkg }) = do
  768. put_ bh mod
  769. put_ bh hsc_src
  770. put_ bh iface_hash
  771. put_ bh mod_hash
  772. put_ bh flag_hash
  773. put_ bh orphan
  774. put_ bh hasFamInsts
  775. lazyPut bh deps
  776. lazyPut bh usages
  777. put_ bh exports
  778. put_ bh exp_hash
  779. put_ bh used_th
  780. put_ bh fixities
  781. lazyPut bh warns
  782. lazyPut bh anns
  783. put_ bh decls
  784. put_ bh insts
  785. put_ bh fam_insts
  786. lazyPut bh rules
  787. put_ bh orphan_hash
  788. put_ bh vect_info
  789. put_ bh hpc_info
  790. put_ bh trust
  791. put_ bh trust_pkg
  792. put_ bh sig_of
  793. get bh = do
  794. mod_name <- get bh
  795. hsc_src <- get bh
  796. iface_hash <- get bh
  797. mod_hash <- get bh
  798. flag_hash <- get bh
  799. orphan <- get bh
  800. hasFamInsts <- get bh
  801. deps <- lazyGet bh
  802. usages <- {-# SCC "bin_usages" #-} lazyGet bh
  803. exports <- {-# SCC "bin_exports" #-} get bh
  804. exp_hash <- get bh
  805. used_th <- get bh
  806. fixities <- {-# SCC "bin_fixities" #-} get bh
  807. warns <- {-# SCC "bin_warns" #-} lazyGet bh
  808. anns <- {-# SCC "bin_anns" #-} lazyGet bh
  809. decls <- {-# SCC "bin_tycldecls" #-} get bh
  810. insts <- {-# SCC "bin_insts" #-} get bh
  811. fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
  812. rules <- {-# SCC "bin_rules" #-} lazyGet bh
  813. orphan_hash <- get bh
  814. vect_info <- get bh
  815. hpc_info <- get bh
  816. trust <- get bh
  817. trust_pkg <- get bh
  818. sig_of <- get bh
  819. return (ModIface {
  820. mi_module = mod_name,
  821. mi_sig_of = sig_of,
  822. mi_hsc_src = hsc_src,
  823. mi_iface_hash = iface_hash,
  824. mi_mod_hash = mod_hash,
  825. mi_flag_hash = flag_hash,
  826. mi_orphan = orphan,
  827. mi_finsts = hasFamInsts,
  828. mi_deps = deps,
  829. mi_usages = usages,
  830. mi_exports = exports,
  831. mi_exp_hash = exp_hash,
  832. mi_used_th = used_th,
  833. mi_anns = anns,
  834. mi_fixities = fixities,
  835. mi_warns = warns,
  836. mi_decls = decls,
  837. mi_globals = Nothing,
  838. mi_insts = insts,
  839. mi_fam_insts = fam_insts,
  840. mi_rules = rules,
  841. mi_orphan_hash = orphan_hash,
  842. mi_vect_info = vect_info,
  843. mi_hpc = hpc_info,
  844. mi_trust = trust,
  845. mi_trust_pkg = trust_pkg,
  846. -- And build the cached values
  847. mi_warn_fn = mkIfaceWarnCache warns,
  848. mi_fix_fn = mkIfaceFixCache fixities,
  849. mi_hash_fn = mkIfaceHashCache decls })
  850. -- | The original names declared of a certain module that are exported
  851. type IfaceExport = AvailInfo
  852. -- | Constructs an empty ModIface
  853. emptyModIface :: Module -> ModIface
  854. emptyModIface mod
  855. = ModIface { mi_module = mod,
  856. mi_sig_of = Nothing,
  857. mi_iface_hash = fingerprint0,
  858. mi_mod_hash = fingerprint0,
  859. mi_flag_hash = fingerprint0,
  860. mi_orphan = False,
  861. mi_finsts = False,
  862. mi_hsc_src = HsSrcFile,
  863. mi_deps = noDependencies,
  864. mi_usages = [],
  865. mi_exports = [],
  866. mi_exp_hash = fingerprint0,
  867. mi_used_th = False,
  868. mi_fixities = [],
  869. mi_warns = NoWarnings,
  870. mi_anns = [],
  871. mi_insts = [],
  872. mi_fam_insts = [],
  873. mi_rules = [],
  874. mi_decls = [],
  875. mi_globals = Nothing,
  876. mi_orphan_hash = fingerprint0,
  877. mi_vect_info = noIfaceVectInfo,
  878. mi_warn_fn = emptyIfaceWarnCache,
  879. mi_fix_fn = emptyIfaceFixCache,
  880. mi_hash_fn = emptyIfaceHashCache,
  881. mi_hpc = False,
  882. mi_trust = noIfaceTrustInfo,
  883. mi_trust_pkg = False }
  884. -- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
  885. mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
  886. -> (OccName -> Maybe (OccName, Fingerprint))
  887. mkIfaceHashCache pairs
  888. = \occ -> lookupOccEnv env occ
  889. where
  890. env = foldr add_decl emptyOccEnv pairs
  891. add_decl (v,d) env0 = foldr add env0 (ifaceDeclFingerprints v d)
  892. where
  893. add (occ,hash) env0 = extendOccEnv env0 occ (occ,hash)
  894. emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
  895. emptyIfaceHashCache _occ = Nothing
  896. -- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
  897. -- for home modules only. Information relating to packages will be loaded into
  898. -- global environments in 'ExternalPackageState'.
  899. data ModDetails
  900. = ModDetails {
  901. -- The next two fields are created by the typechecker
  902. md_exports :: [AvailInfo],
  903. md_types :: !TypeEnv, -- ^ Local type environment for this particular module
  904. -- Includes Ids, TyCons, PatSyns
  905. md_insts :: ![ClsInst], -- ^ 'DFunId's for the instances in this module
  906. md_fam_insts :: ![FamInst],
  907. md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules
  908. md_anns :: ![Annotation], -- ^ Annotations present in this module: currently
  909. -- they only annotate things also declared in this module
  910. md_vect_info :: !VectInfo -- ^ Module vectorisation information
  911. }
  912. -- | Constructs an empty ModDetails
  913. emptyModDetails :: ModDetails
  914. emptyModDetails
  915. = ModDetails { md_types = emptyTypeEnv,
  916. md_exports = [],
  917. md_insts = [],
  918. md_rules = [],
  919. md_fam_insts = [],
  920. md_anns = [],
  921. md_vect_info = noVectInfo }
  922. -- | Records the modules directly imported by a module for extracting e.g.
  923. -- usage information, and also to give better error message
  924. type ImportedMods = ModuleEnv [ImportedModsVal]
  925. data ImportedModsVal
  926. = ImportedModsVal {
  927. imv_name :: ModuleName, -- ^ The name the module is imported with
  928. imv_span :: SrcSpan, -- ^ the source span of the whole import
  929. imv_is_safe :: IsSafeImport, -- ^ whether this is a safe import
  930. imv_is_hiding :: Bool, -- ^ whether this is an "hiding" import
  931. imv_all_exports :: GlobalRdrEnv, -- ^ all the things the module could provide
  932. imv_qualified :: Bool -- ^ whether this is a qualified import
  933. }
  934. -- | A ModGuts is carried through the compiler, accumulating stuff as it goes
  935. -- There is only one ModGuts at any time, the one for the module
  936. -- being compiled right now. Once it is compiled, a 'ModIface' and
  937. -- 'ModDetails' are extracted and the ModGuts is discarded.
  938. data ModGuts
  939. = ModGuts {
  940. mg_module :: !Module, -- ^ Module being compiled
  941. mg_hsc_src :: HscSource, -- ^ Whether it's an hs-boot module
  942. mg_loc :: SrcSpan, -- ^ For error messages from inner passes
  943. mg_exports :: ![AvailInfo], -- ^ What it exports
  944. mg_deps :: !Dependencies, -- ^ What it depends on, directly or
  945. -- otherwise
  946. mg_usages :: ![Usage], -- ^ What was used? Used for interfaces.
  947. mg_used_th :: !Bool, -- ^ Did we run a TH splice?
  948. mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment
  949. -- These fields all describe the things **declared in this module**
  950. mg_fix_env :: !FixityEnv, -- ^ Fixities declared in this module.
  951. -- Used for creating interface files.
  952. mg_tcs :: ![TyCon], -- ^ TyCons declared in this module
  953. -- (includes TyCons for classes)
  954. mg_insts :: ![ClsInst], -- ^ Class instances declared in this module
  955. mg_fam_insts :: ![FamInst],
  956. -- ^ Family instances declared in this module
  957. mg_patsyns :: ![PatSyn], -- ^ Pattern synonyms declared in this module
  958. mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
  959. -- See Note [Overall plumbing for rules] in Rules.hs
  960. mg_binds :: !CoreProgram, -- ^ Bindings for this module
  961. mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module
  962. mg_warns :: !Warnings, -- ^ Warnings declared in the module
  963. mg_anns :: [Annotation], -- ^ Annotations declared in this module
  964. mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
  965. mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module
  966. mg_vect_decls:: ![CoreVect], -- ^ Vectorisation declarations in this module
  967. -- (produced by desugarer & consumed by vectoriser)
  968. mg_vect_info :: !VectInfo, -- ^ Pool of vectorised declarations in the module
  969. -- The next two fields are unusual, because they give instance
  970. -- environments for *all* modules in the home package, including
  971. -- this module, rather than for *just* this module.
  972. -- Reason: when looking up an instance we don't want to have to
  973. -- look at each module in the home package in turn
  974. mg_inst_env :: InstEnv, -- ^ Class instance environment for
  975. -- /home-package/ modules (including this
  976. -- one); c.f. 'tcg_inst_env'
  977. mg_fam_inst_env :: FamInstEnv, -- ^ Type-family instance environment for
  978. -- /home-package/ modules (including this
  979. -- one); c.f. 'tcg_fam_inst_env'
  980. mg_safe_haskell :: SafeHaskellMode, -- ^ Safe Haskell mode
  981. mg_trust_pkg :: Bool -- ^ Do we need to trust our
  982. -- own package for Safe Haskell?
  983. -- See Note [RnNames . Trust Own Package]
  984. }
  985. -- The ModGuts takes on several slightly different forms:
  986. --
  987. -- After simplification, the following fields change slightly:
  988. -- mg_rules Orphan rules only (local ones now attached to binds)
  989. -- mg_binds With rules attached
  990. ---------------------------------------------------------
  991. -- The Tidy pass forks the information about this module:
  992. -- * one lot goes to interface file generation (ModIface)
  993. -- and later compilations (ModDetails)
  994. -- * the other lot goes to code generation (CgGuts)
  995. -- | A restricted form of 'ModGuts' for code generation purposes
  996. data CgGuts
  997. = CgGuts {
  998. cg_module :: !Module,
  999. -- ^ Module being compiled
  1000. cg_tycons :: [TyCon],
  1001. -- ^ Algebraic data types (including ones that started
  1002. -- life as classes); generate constructors and info
  1003. -- tables. Includes newtypes, just for the benefit of
  1004. -- External Core
  1005. cg_binds :: CoreProgram,
  1006. -- ^ The tidied main bindings, including
  1007. -- previously-implicit bindings for record and class
  1008. -- selectors, and data constructor wrappers. But *not*
  1009. -- data constructor workers; reason: we we regard them
  1010. -- as part of the code-gen of tycons
  1011. cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
  1012. cg_dep_pkgs :: ![UnitId], -- ^ Dependent packages, used to
  1013. -- generate #includes for C code gen
  1014. cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
  1015. cg_modBreaks :: !(Maybe ModBreaks) -- ^ Module breakpoints
  1016. }
  1017. -----------------------------------
  1018. -- | Foreign export stubs
  1019. data ForeignStubs
  1020. = NoStubs
  1021. -- ^ We don't have any stubs
  1022. | ForeignStubs SDoc SDoc
  1023. -- ^ There are some stubs. Parameters:
  1024. --
  1025. -- 1) Header file prototypes for
  1026. -- "foreign exported" functions
  1027. --
  1028. -- 2) C stubs to use when calling
  1029. -- "foreign exported" functions
  1030. appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
  1031. appendStubC NoStubs c_code = ForeignStubs empty c_code
  1032. appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
  1033. {-
  1034. ************************************************************************
  1035. * *
  1036. The interactive context
  1037. * *
  1038. ************************************************************************
  1039. Note [The interactive package]
  1040. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1041. Type, class, and value declarations at the command prompt are treated
  1042. as if they were defined in modules
  1043. interactive:Ghci1
  1044. interactive:Ghci2
  1045. ...etc...
  1046. with each bunch of declarations using a new module, all sharing a
  1047. common package 'interactive' (see Module.interactiveUnitId, and
  1048. PrelNames.mkInteractiveModule).
  1049. This scheme deals well with shadowing. For example:
  1050. ghci> data T = A
  1051. ghci> data T = B
  1052. ghci> :i A
  1053. data Ghci1.T = A -- Defined at <interactive>:2:10
  1054. Here we must display info about constructor A, but its type T has been
  1055. shadowed by the second declaration. But it has a respectable
  1056. qualified name (Ghci1.T), and its source location says where it was
  1057. defined.
  1058. So the main invariant continues to hold, that in any session an
  1059. original name M.T only refers to one unique thing. (In a previous
  1060. iteration both the T's above were called :Interactive.T, albeit with
  1061. different uniques, which gave rise to all sorts of trouble.)
  1062. The details are a bit tricky though:
  1063. * The field ic_mod_index counts which Ghci module we've got up to.
  1064. It is incremented when extending ic_tythings
  1065. * ic_tythings contains only things from the 'interactive' package.
  1066. * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go
  1067. in the Home Package Table (HPT). When you say :load, that's when we
  1068. extend the HPT.
  1069. * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.
  1070. It stays as 'main' (or whatever -this-unit-id says), and is the
  1071. package to which :load'ed modules are added to.
  1072. * So how do we arrange that declarations at the command prompt get to
  1073. be in the 'interactive' package? Simply by setting the tcg_mod
  1074. field of the TcGblEnv to "interactive:Ghci1". This is done by the
  1075. call to initTc in initTcInteractive, which in turn get the module
  1076. from it 'icInteractiveModule' field of the interactive context.
  1077. The 'thisPackage' field stays as 'main' (or whatever -this-unit-id says.
  1078. * The main trickiness is that the type environment (tcg_type_env) and
  1079. fixity envt (tcg_fix_env), now contain entities from all the
  1080. interactive-package modules (Ghci1, Ghci2, ...) together, rather
  1081. than just a single module as is usually the case. So you can't use
  1082. "nameIsLocalOrFrom" to decide whether to look in the TcGblEnv vs
  1083. the HPT/PTE. This is a change, but not a problem provided you
  1084. know.
  1085. * However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields
  1086. of the TcGblEnv, which collect "things defined in this module", all
  1087. refer to stuff define in a single GHCi command, *not* all the commands
  1088. so far.
  1089. In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from
  1090. all GhciN modules, which makes sense -- they are all "home package"
  1091. modules.
  1092. Note [Interactively-bound Ids in GHCi]
  1093. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1094. The Ids bound by previous Stmts in GHCi are currently
  1095. a) GlobalIds, with
  1096. b) An External Name, like Ghci4.foo
  1097. See Note [The interactive package] above
  1098. c) A tidied type
  1099. (a) They must be GlobalIds (not LocalIds) otherwise when we come to
  1100. compile an expression using these ids later, the byte code
  1101. generator will consider the occurrences to be free rather than
  1102. global.
  1103. (b) Having an External Name is important because of Note
  1104. [GlobalRdrEnv shadowing] in RdrName
  1105. (c) Their types are tidied. This is important, because :info may ask
  1106. to look at them, and :info expects the things it looks up to have
  1107. tidy types
  1108. Where do interactively-bound Ids come from?
  1109. - GHCi REPL Stmts e.g.
  1110. ghci> let foo x = x+1
  1111. These start with an Internal Name because a Stmt is a local
  1112. construct, so the renamer naturally builds an Internal name for
  1113. each of its binders. Then in tcRnStmt they are externalised via
  1114. TcRnDriver.externaliseAndTidyId, so they get Names like Ghic4.foo.
  1115. - Ids bound by the debugger etc have Names constructed by
  1116. IfaceEnv.newInteractiveBinder; at the call sites it is followed by
  1117. mkVanillaGlobal or mkVanillaGlobalWithInfo. So again, they are
  1118. all Global, External.
  1119. - TyCons, Classes, and Ids bound by other top-level declarations in
  1120. GHCi (eg foreign import, record selectors) also get External
  1121. Names, with Ghci9 (or 8, or 7, etc) as the module name.
  1122. Note [ic_tythings]
  1123. ~~~~~~~~~~~~~~~~~~
  1124. The ic_tythings field contains
  1125. * The TyThings declared by the user at the command prompt
  1126. (eg Ids, TyCons, Classes)
  1127. * The user-visible Ids that arise from such things, which
  1128. *don't* come from 'implicitTyThings', notably:
  1129. - record selectors
  1130. - class ops
  1131. The implicitTyThings are readily obtained from the TyThings
  1132. but record selectors etc are not
  1133. It does *not* contain
  1134. * DFunIds (they can be gotten from ic_instances)
  1135. * CoAxioms (ditto)
  1136. See also Note [Interactively-bound Ids in GHCi]
  1137. Note [Override identical instances in GHCi]
  1138. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1139. If you declare a new instance in GHCi that is identical to a previous one,
  1140. we simply override the previous one; we don't regard it as overlapping.
  1141. e.g. Prelude> data T = A | B
  1142. Prelude> instance Eq T where ...
  1143. Prelude> instance Eq T where ... -- This one overrides
  1144. It's exactly the same for type-family instances. See Trac #7102
  1145. -}
  1146. -- | Interactive context, recording information about the state of the
  1147. -- context in which statements are executed in a GHC session.
  1148. data InteractiveContext
  1149. = InteractiveContext {
  1150. ic_dflags :: DynFlags,
  1151. -- ^ The 'DynFlags' used to evaluate interative expressions
  1152. -- and statements.
  1153. ic_mod_index :: Int,
  1154. -- ^ Each GHCi stmt or declaration brings some new things into
  1155. -- scope. We give them names like interactive:Ghci9.T,
  1156. -- where the ic_index is the '9'. The ic_mod_index is
  1157. -- incremented whenever we add something to ic_tythings
  1158. -- See Note [The interactive package]
  1159. ic_imports :: [InteractiveImport],
  1160. -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with
  1161. -- these imports
  1162. --
  1163. -- This field is only stored here so that the client
  1164. -- can retrieve it with GHC.getContext. GHC itself doesn't
  1165. -- use it, but does reset it to empty sometimes (such
  1166. -- as before a GHC.load). The context is set with GHC.setContext.
  1167. ic_tythings :: [TyThing],
  1168. -- ^ TyThings defined by the user, in reverse order of
  1169. -- definition (ie most recent at the front)
  1170. -- See Note [ic_tythings]
  1171. ic_rn_gbl_env :: GlobalRdrEnv,
  1172. -- ^ The cached 'GlobalRdrEnv', built by
  1173. -- 'InteractiveEval.setContext' and updated regularly
  1174. -- It contains everything in scope at the command line,
  1175. -- including everything in ic_tythings
  1176. ic_instances :: ([ClsInst], [FamInst]),
  1177. -- ^ All instances and family instances created during
  1178. -- this session. These are grabbed en masse after each
  1179. -- update to be sure that proper overlapping is retained.
  1180. -- That is, rather than re-check the overlapping each
  1181. -- time we update the context, we just take the results
  1182. -- from the instance code that already does that.
  1183. ic_fix_env :: FixityEnv,
  1184. -- ^ Fixities declared in let statements
  1185. ic_default :: Maybe [Type],
  1186. -- ^ The current default types, set by a 'default' declaration
  1187. #ifdef GHCI
  1188. ic_resume :: [Resume],
  1189. -- ^ The stack of breakpoint contexts
  1190. #endif
  1191. ic_monad :: Name,
  1192. -- ^ The monad that GHCi is executing in
  1193. ic_int_print :: Name,
  1194. -- ^ The function that is used for printing results
  1195. -- of expressions in ghci and -e mode.
  1196. ic_cwd :: Maybe FilePath
  1197. -- virtual CWD of the program
  1198. }
  1199. data InteractiveImport
  1200. = IIDecl (ImportDecl RdrName)
  1201. -- ^ Bring the exports of a particular module
  1202. -- (filtered by an import decl) into scope
  1203. | IIModule ModuleName
  1204. -- ^ Bring into scope the entire top-level envt of
  1205. -- of this module, including the things imported
  1206. -- into it.
  1207. -- | Constructs an empty InteractiveContext.
  1208. emptyInteractiveContext :: DynFlags -> InteractiveContext
  1209. emptyInteractiveContext dflags
  1210. = InteractiveContext {
  1211. ic_dflags = dflags,
  1212. ic_imports = [],
  1213. ic_rn_gbl_env = emptyGlobalRdrEnv,
  1214. ic_mod_index = 1,
  1215. ic_tythings = [],
  1216. ic_instances = ([],[]),
  1217. ic_fix_env = emptyNameEnv,
  1218. ic_monad = ioTyConName, -- IO monad by default
  1219. ic_int_print = printName, -- System.IO.print by default
  1220. ic_default = Nothing,
  1221. #ifdef GHCI
  1222. ic_resume = [],
  1223. #endif
  1224. ic_cwd = Nothing }
  1225. icInteractiveModule :: InteractiveContext -> Module
  1226. icInteractiveModule (InteractiveContext { ic_mod_index = index })
  1227. = mkInteractiveModule index
  1228. -- | This function returns the list of visible TyThings (useful for
  1229. -- e.g. showBindings)
  1230. icInScopeTTs :: InteractiveContext -> [TyThing]
  1231. icInScopeTTs = ic_tythings
  1232. -- | Get the PrintUnqualified function based on the flags and this InteractiveContext
  1233. icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
  1234. icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
  1235. mkPrintUnqualified dflags grenv
  1236. -- | extendInteractiveContext is called with new TyThings recently defined to update the
  1237. -- InteractiveContext to include them. Ids are easily removed when shadowed,
  1238. -- but Classes and TyCons are not. Some work could be done to determine
  1239. -- whether they are entirely shadowed, but as you could still have references
  1240. -- to them (e.g. instances for classes or values of the type for TyCons), it's
  1241. -- not clear whether removing them is even the appropriate behavior.
  1242. extendInteractiveContext :: InteractiveContext
  1243. -> [TyThing]
  1244. -> [ClsInst] -> [FamInst]
  1245. -> Maybe [Type]
  1246. -> FixityEnv
  1247. -> InteractiveContext
  1248. extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env
  1249. = ictxt { ic_mod_index = ic_mod_index ictxt + 1
  1250. -- Always bump this; even instances should create
  1251. -- a new mod_index (Trac #9426)
  1252. , ic_tythings = new_tythings ++ old_tythings
  1253. , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
  1254. , ic_instances = ( new_cls_insts ++ old_cls_insts
  1255. , new_fam_insts ++ old_fam_insts )
  1256. , ic_default = defaults
  1257. , ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi]
  1258. }
  1259. where
  1260. new_ids = [id | AnId id <- new_tythings]
  1261. old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
  1262. -- Discard old instances that have been fully overrridden
  1263. -- See Note [Override identical instances in GHCi]
  1264. (cls_insts, fam_insts) = ic_instances ictxt
  1265. old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts
  1266. old_fam_insts = filterOut (\i -> any (identicalFamInstHead i) new_fam_insts) fam_insts
  1267. extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
  1268. -- Just a specialised version
  1269. extendInteractiveContextWithIds ictxt new_ids
  1270. | null new_ids = ictxt
  1271. | otherwise = ictxt { ic_mod_index = ic_mod_index ictxt + 1
  1272. , ic_tythings = new_tythings ++ old_tythings
  1273. , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }
  1274. where
  1275. new_tythings = map AnId new_ids
  1276. old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
  1277. shadowed_by :: [Id] -> TyThing -> Bool
  1278. shadowed_by ids = shadowed
  1279. where
  1280. shadowed id = getOccName id `elemOccSet` new_occs
  1281. new_occs = mkOccSet (map getOccName ids)
  1282. setInteractivePackage :: HscEnv -> HscEnv
  1283. -- Set the 'thisPackage' DynFlag to 'interactive'
  1284. setInteractivePackage hsc_env
  1285. = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactiveUnitId } }
  1286. setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
  1287. setInteractivePrintName ic n = ic{ic_int_print = n}
  1288. -- ToDo: should not add Ids to the gbl env here
  1289. -- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
  1290. -- later ones, and shadowing existing entries in the GlobalRdrEnv.
  1291. icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
  1292. icExtendGblRdrEnv env tythings
  1293. = foldr add env tythings -- Foldr makes things in the front of
  1294. -- the list shadow things at the back
  1295. where
  1296. -- One at a time, to ensure each shadows the previous ones
  1297. add thing env
  1298. | is_sub_bndr thing
  1299. = env
  1300. | otherwise
  1301. = foldl extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)
  1302. where
  1303. env1 = shadowNames env (concatMap availNames avail)
  1304. avail = tyThingAvailInfo thing
  1305. -- Ugh! The new_tythings may include record selectors, since they
  1306. -- are not implicit-ids, and must appear in the TypeEnv. But they
  1307. -- will also be brought into scope by the corresponding (ATyCon
  1308. -- tc). And we want the latter, because that has the correct
  1309. -- parent (Trac #10520)
  1310. is_sub_bndr (AnId f) = case idDetails f of
  1311. RecSelId {} -> True
  1312. ClassOpId {} -> True
  1313. _ -> False
  1314. is_sub_bndr _ = False
  1315. substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
  1316. substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
  1317. | isEmptyTCvSubst subst = ictxt
  1318. | otherwise = ictxt { ic_tythings = map subst_ty tts }
  1319. where
  1320. subst_ty (AnId id) = AnId $ id `setIdType` substTyUnchecked subst (idType id)
  1321. subst_ty tt = tt
  1322. instance Outputable InteractiveImport where
  1323. ppr (IIModule m) = char '*' <> ppr m
  1324. ppr (IIDecl d) = ppr d
  1325. {-
  1326. ************************************************************************
  1327. * *
  1328. Building a PrintUnqualified
  1329. * *
  1330. ************************************************************************
  1331. Note [Printing original names]
  1332. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1333. Deciding how to print names is pretty tricky. We are given a name
  1334. P:M.T, where P is the package name, M is the defining module, and T is
  1335. the occurrence name, and we have to decide in which form to display
  1336. the name given a GlobalRdrEnv describing the current scope.
  1337. Ideally we want to display the name in the form in which it is in
  1338. scope. However, the name might not be in scope at all, and that's
  1339. where it gets tricky. Here are the cases:
  1340. 1. T uniquely maps to P:M.T ---> "T" NameUnqual
  1341. 2. There is an X for which X.T
  1342. uniquely maps to P:M.T ---> "X.T" NameQual X
  1343. 3. There is no binding for "M.T" ---> "M.T" NameNotInScope1
  1344. 4. Otherwise ---> "P:M.T" NameNotInScope2
  1345. (3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
  1346. all. In these cases we still want to refer to the name as "M.T", *but*
  1347. "M.T" might mean something else in the current scope (e.g. if there's
  1348. an "import X as M"), so to avoid confusion we avoid using "M.T" if
  1349. there's already a binding for it. Instead we write P:M.T.
  1350. There's one further subtlety: in case (3), what if there are two
  1351. things around, P1:M.T and P2:M.T? Then we don't want to print both of
  1352. them as M.T! However only one of the modules P1:M and P2:M can be
  1353. exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
  1354. This is handled by the qual_mod component of PrintUnqualified, inside
  1355. the (ppr mod) of case (3), in Name.pprModulePrefix
  1356. Note [Printing unit ids]
  1357. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1358. In the old days, original names were tied to PackageIds, which directly
  1359. corresponded to the entities that users wrote in Cabal files, and were perfectly
  1360. suitable for printing when we need to disambiguate packages. However, with
  1361. UnitId, the situation can be different: if the key is instantiated with
  1362. some holes, we should try to give the user some more useful information.
  1363. -}
  1364. -- | Creates some functions that work out the best ways to format
  1365. -- names for the user according to a set of heuristics.
  1366. mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
  1367. mkPrintUnqualified dflags env = QueryQualify qual_name
  1368. (mkQualModule dflags)
  1369. (mkQualPackage dflags)
  1370. where
  1371. qual_name mod occ
  1372. | [gre] <- unqual_gres
  1373. , right_name gre
  1374. = NameUnqual -- If there's a unique entity that's in scope
  1375. -- unqualified with 'occ' AND that entity is
  1376. -- the right one, then we can use the unqualified name
  1377. | [] <- unqual_gres
  1378. , any is_name forceUnqualNames
  1379. , not (isDerivedOccName occ)
  1380. = NameUnqual -- Don't qualify names that come from modules
  1381. -- that come with GHC, often appear in error messages,
  1382. -- but aren't typically in scope. Doing this does not
  1383. -- cause ambiguity, and it reduces the amount of
  1384. -- qualification in error messages thus improving
  1385. -- readability.
  1386. --
  1387. -- A motivating example is 'Constraint'. It's often not
  1388. -- in scope, but printing GHC.Prim.Constraint seems
  1389. -- overkill.
  1390. | [gre] <- qual_gres
  1391. = NameQual (greQualModName gre)
  1392. | null qual_gres
  1393. = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
  1394. then NameNotInScope1
  1395. else NameNotInScope2
  1396. | otherwise
  1397. = NameNotInScope1 -- Can happen if 'f' is bound twice in the module
  1398. -- Eg f = True; g = 0; f = False
  1399. where
  1400. is_name :: Name -> Bool
  1401. is_name name = ASSERT2( isExternalName name, ppr name )
  1402. nameModule name == mod && nameOccName name == occ
  1403. forceUnqualNames :: [Name]
  1404. forceUnqualNames =
  1405. map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon
  1406. , starKindTyCon, unicodeStarKindTyCon ]
  1407. ++ [ eqTyConName ]
  1408. right_name gre = nameModule_maybe (gre_name gre) == Just mod
  1409. unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
  1410. qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
  1411. -- we can mention a module P:M without the P: qualifier iff
  1412. -- "import M" would resolve unambiguously to P:M. (if P is the
  1413. -- current package we can just assume it is unqualified).
  1414. -- | Creates a function for formatting modules based on two heuristics:
  1415. -- (1) if the module is the current module, don't qualify, and (2) if there
  1416. -- is only one exposed package which exports this module, don't qualify.
  1417. mkQualModule :: DynFlags -> QueryQualifyModule
  1418. mkQualModule dflags mod
  1419. | moduleUnitId mod == thisPackage dflags = False
  1420. | [(_, pkgconfig)] <- lookup,
  1421. packageConfigId pkgconfig == moduleUnitId mod
  1422. -- this says: we are given a module P:M, is there just one exposed package
  1423. -- that exposes a module M, and is it package P?
  1424. = False
  1425. | otherwise = True
  1426. where lookup = lookupModuleInAllPackages dflags (moduleName mod)
  1427. -- | Creates a function for formatting packages based on two heuristics:
  1428. -- (1) don't qualify if the package in question is "main", and (2) only qualify
  1429. -- with a unit id if the package ID would be ambiguous.
  1430. mkQualPackage :: DynFlags -> QueryQualifyPackage
  1431. mkQualPackage dflags pkg_key
  1432. | pkg_key == mainUnitId || pkg_key == interactiveUnitId
  1433. -- Skip the lookup if it's main, since it won't be in the package
  1434. -- database!
  1435. = False
  1436. | Just pkgid <- mb_pkgid
  1437. , searchPackageId dflags pkgid `lengthIs` 1
  1438. -- this says: we are given a package pkg-0.1@MMM, are there only one
  1439. -- exposed packages whose package ID is pkg-0.1?
  1440. = False
  1441. | otherwise
  1442. = True
  1443. where mb_pkgid = fmap sourcePackageId (lookupPackage dflags pkg_key)
  1444. -- | A function which only qualifies package names if necessary; but
  1445. -- qualifies all other identifiers.
  1446. pkgQual :: DynFlags -> PrintUnqualified
  1447. pkgQual dflags = alwaysQualify {
  1448. queryQualifyPackage = mkQualPackage dflags
  1449. }
  1450. {-
  1451. ************************************************************************
  1452. * *
  1453. Implicit TyThings
  1454. * *
  1455. ************************************************************************
  1456. Note [Implicit TyThings]
  1457. ~~~~~~~~~~~~~~~~~~~~~~~~
  1458. DEFINITION: An "implicit" TyThing is one that does not have its own
  1459. IfaceDecl in an interface file. Instead, its binding in the type
  1460. environment is created as part of typechecking the IfaceDecl for
  1461. some other thing.
  1462. Examples:
  1463. * All DataCons are implicit, because they are generated from the
  1464. IfaceDecl for the data/newtype. Ditto class methods.
  1465. * Record selectors are *not* implicit, because they get their own
  1466. free-standing IfaceDecl.
  1467. * Associated data/type families are implicit because they are
  1468. included in the IfaceDecl of the parent class. (NB: the
  1469. IfaceClass decl happens to use IfaceDecl recursively for the
  1470. associated types, but that's irrelevant here.)
  1471. * Dictionary function Ids are not implicit.
  1472. * Axioms for newtypes are implicit (same as above), but axioms
  1473. for data/type family instances are *not* implicit (like DFunIds).
  1474. -}
  1475. -- | Determine the 'TyThing's brought into scope by another 'TyThing'
  1476. -- /other/ than itself. For example, Id's don't have any implicit TyThings
  1477. -- as they just bring themselves into scope, but classes bring their
  1478. -- dictionary datatype, type constructor and some selector functions into
  1479. -- scope, just for a start!
  1480. -- N.B. the set of TyThings returned here *must* match the set of
  1481. -- names returned by LoadIface.ifaceDeclImplicitBndrs, in the sense that
  1482. -- TyThing.getOccName should define a bijection between the two lists.
  1483. -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
  1484. -- The order of the list does not matter.
  1485. implicitTyThings :: TyThing -> [TyThing]
  1486. implicitTyThings (AnId _) = []
  1487. implicitTyThings (ACoAxiom _cc) = []
  1488. implicitTyThings (ATyCon tc) = implicitTyConThings tc
  1489. implicitTyThings (AConLike cl) = implicitConLikeThings cl
  1490. implicitConLikeThings :: ConLike -> [TyThing]
  1491. implicitConLikeThings (RealDataCon dc)
  1492. = dataConImplicitTyThings dc
  1493. implicitConLikeThings (PatSynCon {})
  1494. = [] -- Pattern synonyms have no implicit Ids; the wrapper and matcher
  1495. -- are not "implicit"; they are simply new top-level bindings,
  1496. -- and they have their own declaration in an interface file
  1497. -- Unless a record pat syn when there are implicit selectors
  1498. -- They are still not included here as `implicitConLikeThings` is
  1499. -- used by `tcTyClsDecls` whilst pattern synonyms are typed checked
  1500. -- by `tcTopValBinds`.
  1501. implicitClassThings :: Class -> [TyThing]
  1502. implicitClassThings cl
  1503. = -- Does not include default methods, because those Ids may have
  1504. -- their own pragmas, unfoldings etc, not derived from the Class object
  1505. -- associated types
  1506. -- No recursive call for the classATs, because they
  1507. -- are only the family decls; they have no implicit things
  1508. map ATyCon (classATs cl) ++
  1509. -- superclass and operation selectors
  1510. map AnId (classAllSelIds cl)
  1511. implicitTyConThings :: TyCon -> [TyThing]
  1512. implicitTyConThings tc
  1513. = class_stuff ++
  1514. -- fields (names of selectors)
  1515. -- (possibly) implicit newtype axioms
  1516. -- or type family axioms
  1517. implicitCoTyCon tc ++
  1518. -- for each data constructor in order,
  1519. -- the constructor, worker, and (possibly) wrapper
  1520. [ thing | dc <- tyConDataCons tc
  1521. , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]
  1522. -- NB. record selectors are *not* implicit, they have fully-fledged
  1523. -- bindings that pass through the compilation pipeline as normal.
  1524. where
  1525. class_stuff = case tyConClass_maybe tc of
  1526. Nothing -> []
  1527. Just cl -> implicitClassThings cl
  1528. -- For newtypes and closed type families (only) add the implicit coercion tycon
  1529. implicitCoTyCon :: TyCon -> [TyThing]
  1530. implicitCoTyCon tc
  1531. | Just co <- newTyConCo_maybe tc = [ACoAxiom $ toBranchedAxiom co]
  1532. | Just co <- isClosedSynFamilyTyConWithAxiom_maybe tc
  1533. = [ACoAxiom co]
  1534. | otherwise = []
  1535. -- | Returns @True@ if there should be no interface-file declaration
  1536. -- for this thing on its own: either it is built-in, or it is part
  1537. -- of some other declaration, or it is generated implicitly by some
  1538. -- other declaration.
  1539. isImplicitTyThing :: TyThing -> Bool
  1540. isImplicitTyThing (AConLike cl) = case cl of
  1541. RealDataCon {} -> True
  1542. PatSynCon {} -> False
  1543. isImplicitTyThing (AnId id) = isImplicitId id
  1544. isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
  1545. isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
  1546. -- | tyThingParent_maybe x returns (Just p)
  1547. -- when pprTyThingInContext sould print a declaration for p
  1548. -- (albeit with some "..." in it) when asked to show x
  1549. -- It returns the *immediate* parent. So a datacon returns its tycon
  1550. -- but the tycon could be the associated type of a class, so it in turn
  1551. -- might have a parent.
  1552. tyThingParent_maybe :: TyThing -> Maybe TyThing
  1553. tyThingParent_maybe (AConLike cl) = case cl of
  1554. RealDataCon dc -> Just (ATyCon (dataConTyCon dc))
  1555. PatSynCon{} -> Nothing
  1556. tyThingParent_maybe (ATyCon tc) = case tyConAssoc_maybe tc of
  1557. Just cls -> Just (ATyCon (classTyCon cls))
  1558. Nothing -> Nothing
  1559. tyThingParent_maybe (AnId id) = case idDetails id of
  1560. RecSelId { sel_tycon = RecSelData tc } ->
  1561. Just (ATyCon tc)
  1562. ClassOpId cls ->
  1563. Just (ATyCon (classTyCon cls))
  1564. _other -> Nothing
  1565. tyThingParent_maybe _other = Nothing
  1566. tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
  1567. tyThingsTyCoVars tts =
  1568. unionVarSets $ map ttToVarSet tts
  1569. where
  1570. ttToVarSet (AnId id) = tyCoVarsOfType $ idType id
  1571. ttToVarSet (AConLike cl) = case cl of
  1572. RealDataCon dc -> tyCoVarsOfType $ dataConRepType dc
  1573. PatSynCon{} -> emptyVarSet
  1574. ttToVarSet (ATyCon tc)
  1575. = case tyConClass_maybe tc of
  1576. Just cls -> (mkVarSet . fst . classTvsFds) cls
  1577. Nothing -> tyCoVarsOfType $ tyConKind tc
  1578. ttToVarSet (ACoAxiom _) = emptyVarSet
  1579. -- | The Names that a TyThing should bring into scope. Used to build
  1580. -- the GlobalRdrEnv for the InteractiveContext.
  1581. tyThingAvailInfo :: TyThing -> [AvailInfo]
  1582. tyThingAvailInfo (ATyCon t)
  1583. = case tyConClass_maybe t of
  1584. Just c -> [AvailTC n (n : map getName (classMethods c)
  1585. ++ map getName (classATs c))
  1586. [] ]
  1587. where n = getName c
  1588. Nothing -> [AvailTC n (n : map getName dcs) flds]
  1589. where n = getName t
  1590. dcs = tyConDataCons t
  1591. flds = tyConFieldLabels t
  1592. tyThingAvailInfo (AConLike (PatSynCon p))
  1593. = map patSynAvail ((getName p) : map flSelector (patSynFieldLabels p))
  1594. tyThingAvailInfo t
  1595. = [avail (getName t)]
  1596. {-
  1597. ************************************************************************
  1598. * *
  1599. TypeEnv
  1600. * *
  1601. ************************************************************************
  1602. -}
  1603. -- | A map from 'Name's to 'TyThing's, constructed by typechecking
  1604. -- local declarations or interface files
  1605. type TypeEnv = NameEnv TyThing
  1606. emptyTypeEnv :: TypeEnv
  1607. typeEnvElts :: TypeEnv -> [TyThing]
  1608. typeEnvTyCons :: TypeEnv -> [TyCon]
  1609. typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
  1610. typeEnvIds :: TypeEnv -> [Id]
  1611. typeEnvPatSyns :: TypeEnv -> [PatSyn]
  1612. typeEnvDataCons :: TypeEnv -> [DataCon]
  1613. typeEnvClasses :: TypeEnv -> [Class]
  1614. lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
  1615. emptyTypeEnv = emptyNameEnv
  1616. typeEnvElts env = nameEnvElts env
  1617. typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
  1618. typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
  1619. typeEnvIds env = [id | AnId id <- typeEnvElts env]
  1620. typeEnvPatSyns env = [ps | AConLike (PatSynCon ps) <- typeEnvElts env]
  1621. typeEnvDataCons env = [dc | AConLike (RealDataCon dc) <- typeEnvElts env]
  1622. typeEnvClasses env = [cl | tc <- typeEnvTyCons env,
  1623. Just cl <- [tyConClass_maybe tc]]
  1624. mkTypeEnv :: [TyThing] -> TypeEnv
  1625. mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
  1626. mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
  1627. mkTypeEnvWithImplicits things =
  1628. mkTypeEnv things
  1629. `plusNameEnv`
  1630. mkTypeEnv (concatMap implicitTyThings things)
  1631. typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv
  1632. typeEnvFromEntities ids tcs famInsts =
  1633. mkTypeEnv ( map AnId ids
  1634. ++ map ATyCon all_tcs
  1635. ++ concatMap implicitTyConThings all_tcs
  1636. ++ map (ACoAxiom . toBranchedAxiom . famInstAxiom) famInsts
  1637. )
  1638. where
  1639. all_tcs = tcs ++ famInstsRepTyCons famInsts
  1640. lookupTypeEnv = lookupNameEnv
  1641. -- Extend the type environment
  1642. extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
  1643. extendTypeEnv env thing = extendNameEnv env (getName thing) thing
  1644. extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
  1645. extendTypeEnvList env things = foldl extendTypeEnv env things
  1646. extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
  1647. extendTypeEnvWithIds env ids
  1648. = extendNameEnvList env [(getName id, AnId id) | id <- ids]
  1649. plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
  1650. plusTypeEnv env1 env2 = plusNameEnv env1 env2
  1651. -- | Find the 'TyThing' for the given 'Name' by using all the resources
  1652. -- at our disposal: the compiled modules in the 'HomePackageTable' and the
  1653. -- compiled modules in other packages that live in 'PackageTypeEnv'. Note
  1654. -- that this does NOT look up the 'TyThing' in the module being compiled: you
  1655. -- have to do that yourself, if desired
  1656. lookupType :: DynFlags
  1657. -> HomePackageTable
  1658. -> PackageTypeEnv
  1659. -> Name
  1660. -> Maybe TyThing
  1661. lookupType dflags hpt pte name
  1662. | isOneShot (ghcMode dflags) -- in one-shot, we don't use the HPT
  1663. = lookupNameEnv pte name
  1664. | otherwise
  1665. = case lookupHptByModule hpt mod of
  1666. Just hm -> lookupNameEnv (md_types (hm_details hm)) name
  1667. Nothing -> lookupNameEnv pte name
  1668. where
  1669. mod = ASSERT2( isExternalName name, ppr name ) nameModule name
  1670. -- | As 'lookupType', but with a marginally easier-to-use interface
  1671. -- if you have a 'HscEnv'
  1672. lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
  1673. lookupTypeHscEnv hsc_env name = do
  1674. eps <- readIORef (hsc_EPS hsc_env)
  1675. return $! lookupType dflags hpt (eps_PTE eps) name
  1676. where
  1677. dflags = hsc_dflags hsc_env
  1678. hpt = hsc_HPT hsc_env
  1679. -- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
  1680. tyThingTyCon :: TyThing -> TyCon
  1681. tyThingTyCon (ATyCon tc) = tc
  1682. tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
  1683. -- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
  1684. tyThingCoAxiom :: TyThing -> CoAxiom Branched
  1685. tyThingCoAxiom (ACoAxiom ax) = ax
  1686. tyThingCoAxiom other = pprPanic "tyThingCoAxiom" (ppr other)
  1687. -- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
  1688. tyThingDataCon :: TyThing -> DataCon
  1689. tyThingDataCon (AConLike (RealDataCon dc)) = dc
  1690. tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other)
  1691. -- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
  1692. tyThingId :: TyThing -> Id
  1693. tyThingId (AnId id) = id
  1694. tyThingId (AConLike (RealDataCon dc)) = dataConWrapId dc
  1695. tyThingId other = pprPanic "tyThingId" (ppr other)
  1696. {-
  1697. ************************************************************************
  1698. * *
  1699. \subsection{MonadThings and friends}
  1700. * *
  1701. ************************************************************************
  1702. -}
  1703. -- | Class that abstracts out the common ability of the monads in GHC
  1704. -- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides
  1705. -- a number of related convenience functions for accessing particular
  1706. -- kinds of 'TyThing'
  1707. class Monad m => MonadThings m where
  1708. lookupThing :: Name -> m TyThing
  1709. lookupId :: Name -> m Id
  1710. lookupId = liftM tyThingId . lookupThing
  1711. lookupDataCon :: Name -> m DataCon
  1712. lookupDataCon = liftM tyThingDataCon . lookupThing
  1713. lookupTyCon :: Name -> m TyCon
  1714. lookupTyCon = liftM tyThingTyCon . lookupThing
  1715. {-
  1716. ************************************************************************
  1717. * *
  1718. \subsection{Auxiliary types}
  1719. * *
  1720. ************************************************************************
  1721. These types are defined here because they are mentioned in ModDetails,
  1722. but they are mostly elaborated elsewhere
  1723. -}
  1724. ------------------ Warnings -------------------------
  1725. -- | Warning information for a module
  1726. data Warnings
  1727. = NoWarnings -- ^ Nothing deprecated
  1728. | WarnAll WarningTxt -- ^ Whole module deprecated
  1729. | WarnSome [(OccName,WarningTxt)] -- ^ Some specific things deprecated
  1730. -- Only an OccName is needed because
  1731. -- (1) a deprecation always applies to a binding
  1732. -- defined in the module in which the deprecation appears.
  1733. -- (2) deprecations are only reported outside the defining module.
  1734. -- this is important because, otherwise, if we saw something like
  1735. --
  1736. -- {-# DEPRECATED f "" #-}
  1737. -- f = ...
  1738. -- h = f
  1739. -- g = let f = undefined in f
  1740. --
  1741. -- we'd need more information than an OccName to know to say something
  1742. -- about the use of f in h but not the use of the locally bound f in g
  1743. --
  1744. -- however, because we only report about deprecations from the outside,
  1745. -- and a module can only export one value called f,
  1746. -- an OccName suffices.
  1747. --
  1748. -- this is in contrast with fixity declarations, where we need to map
  1749. -- a Name to its fixity declaration.
  1750. deriving( Eq )
  1751. instance Binary Warnings where
  1752. put_ bh NoWarnings = putByte bh 0
  1753. put_ bh (WarnAll t) = do
  1754. putByte bh 1
  1755. put_ bh t
  1756. put_ bh (WarnSome ts) = do
  1757. putByte bh 2
  1758. put_ bh ts
  1759. get bh = do
  1760. h <- getByte bh
  1761. case h of
  1762. 0 -> return NoWarnings
  1763. 1 -> do aa <- get bh
  1764. return (WarnAll aa)
  1765. _ -> do aa <- get bh
  1766. return (WarnSome aa)
  1767. -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'
  1768. mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt
  1769. mkIfaceWarnCache NoWarnings = \_ -> Nothing
  1770. mkIfaceWarnCache (WarnAll t) = \_ -> Just t
  1771. mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs)
  1772. emptyIfaceWarnCache :: OccName -> Maybe WarningTxt
  1773. emptyIfaceWarnCache _ = Nothing
  1774. plusWarns :: Warnings -> Warnings -> Warnings
  1775. plusWarns d NoWarnings = d
  1776. plusWarns NoWarnings d = d
  1777. plusWarns _ (WarnAll t) = WarnAll t
  1778. plusWarns (WarnAll t) _ = WarnAll t
  1779. plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
  1780. -- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
  1781. mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity
  1782. mkIfaceFixCache pairs
  1783. = \n -> lookupOccEnv env n
  1784. where
  1785. env = mkOccEnv pairs
  1786. emptyIfaceFixCache :: OccName -> Maybe Fixity
  1787. emptyIfaceFixCache _ = Nothing
  1788. -- | Fixity environment mapping names to their fixities
  1789. type FixityEnv = NameEnv FixItem
  1790. -- | Fixity information for an 'Name'. We keep the OccName in the range
  1791. -- so that we can generate an interface from it
  1792. data FixItem = FixItem OccName Fixity
  1793. instance Outputable FixItem where
  1794. ppr (FixItem occ fix) = ppr fix <+> ppr occ
  1795. emptyFixityEnv :: FixityEnv
  1796. emptyFixityEnv = emptyNameEnv
  1797. lookupFixity :: FixityEnv -> Name -> Fixity
  1798. lookupFixity env n = case lookupNameEnv env n of
  1799. Just (FixItem _ fix) -> fix
  1800. Nothing -> defaultFixity
  1801. {-
  1802. ************************************************************************
  1803. * *
  1804. \subsection{WhatsImported}
  1805. * *
  1806. ************************************************************************
  1807. -}
  1808. -- | Records whether a module has orphans. An \"orphan\" is one of:
  1809. --
  1810. -- * An instance declaration in a module other than the definition
  1811. -- module for one of the type constructors or classes in the instance head
  1812. --
  1813. -- * A transformation rule in a module other than the one defining
  1814. -- the function in the head of the rule
  1815. --
  1816. -- * A vectorisation pragma
  1817. type WhetherHasOrphans = Bool
  1818. -- | Does this module define family instances?
  1819. type WhetherHasFamInst = Bool
  1820. -- | Did this module originate from a *-boot file?
  1821. type IsBootInterface = Bool
  1822. -- | Dependency information about ALL modules and packages below this one
  1823. -- in the import hierarchy.
  1824. --
  1825. -- Invariant: the dependencies of a module @M@ never includes @M@.
  1826. --
  1827. -- Invariant: none of the lists contain duplicates.
  1828. data Dependencies
  1829. = Deps { dep_mods :: [(ModuleName, IsBootInterface)]
  1830. -- ^ All home-package modules transitively below this one
  1831. -- I.e. modules that this one imports, or that are in the
  1832. -- dep_mods of those directly-imported modules
  1833. , dep_pkgs :: [(UnitId, Bool)]
  1834. -- ^ All packages transitively below this module
  1835. -- I.e. packages to which this module's direct imports belong,
  1836. -- or that are in the dep_pkgs of those modules
  1837. -- The bool indicates if the package is required to be
  1838. -- trusted when the module is imported as a safe import
  1839. -- (Safe Haskell). See Note [RnNames . Tracking Trust Transitively]
  1840. , dep_orphs :: [Module]
  1841. -- ^ Transitive closure of orphan modules (whether
  1842. -- home or external pkg).
  1843. --
  1844. -- (Possible optimization: don't include family
  1845. -- instance orphans as they are anyway included in
  1846. -- 'dep_finsts'. But then be careful about code
  1847. -- which relies on dep_orphs having the complete list!)
  1848. , dep_finsts :: [Module]
  1849. -- ^ Modules that contain family instances (whether the
  1850. -- instances are from the home or an external package)
  1851. }
  1852. deriving( Eq )
  1853. -- Equality used only for old/new comparison in MkIface.addFingerprints
  1854. -- See 'TcRnTypes.ImportAvails' for details on dependencies.
  1855. instance Binary Dependencies where
  1856. put_ bh deps = do put_ bh (dep_mods deps)
  1857. put_ bh (dep_pkgs deps)
  1858. put_ bh (dep_orphs deps)
  1859. put_ bh (dep_finsts deps)
  1860. get bh = do ms <- get bh
  1861. ps <- get bh
  1862. os <- get bh
  1863. fis <- get bh
  1864. return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
  1865. dep_finsts = fis })
  1866. noDependencies :: Dependencies
  1867. noDependencies = Deps [] [] [] []
  1868. -- | Records modules for which changes may force recompilation of this module
  1869. -- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
  1870. --
  1871. -- This differs from Dependencies. A module X may be in the dep_mods of this
  1872. -- module (via an import chain) but if we don't use anything from X it won't
  1873. -- appear in our Usage
  1874. data Usage
  1875. -- | Module from another package
  1876. = UsagePackageModule {
  1877. usg_mod :: Module,
  1878. -- ^ External package module depended on
  1879. usg_mod_hash :: Fingerprint,
  1880. -- ^ Cached module fingerprint
  1881. usg_safe :: IsSafeImport
  1882. -- ^ Was this module imported as a safe import
  1883. }
  1884. -- | Module from the current package
  1885. | UsageHomeModule {
  1886. usg_mod_name :: ModuleName,
  1887. -- ^ Name of the module
  1888. usg_mod_hash :: Fingerprint,
  1889. -- ^ Cached module fingerprint
  1890. usg_entities :: [(OccName,Fingerprint)],
  1891. -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.
  1892. -- NB: usages are for parent names only, e.g. type constructors
  1893. -- but not the associated data constructors.
  1894. usg_exports :: Maybe Fingerprint,
  1895. -- ^ Fingerprint for the export list of this module,
  1896. -- if we directly imported it (and hence we depend on its export list)
  1897. usg_safe :: IsSafeImport
  1898. -- ^ Was this module imported as a safe import
  1899. } -- ^ Module from the current package
  1900. -- | A file upon which the module depends, e.g. a CPP #include, or using TH's
  1901. -- 'addDependentFile'
  1902. | UsageFile {
  1903. usg_file_path :: FilePath,
  1904. -- ^ External file dependency. From a CPP #include or TH
  1905. -- addDependentFile. Should be absolute.
  1906. usg_file_hash :: Fingerprint
  1907. -- ^ 'Fingerprint' of the file contents.
  1908. -- Note: We don't consider things like modification timestamps
  1909. -- here, because there's no reason to recompile if the actual
  1910. -- contents don't change. This previously lead to odd
  1911. -- recompilation behaviors; see #8114
  1912. }
  1913. deriving( Eq )
  1914. -- The export list field is (Just v) if we depend on the export list:
  1915. -- i.e. we imported the module directly, whether or not we
  1916. -- enumerated the things we imported, or just imported
  1917. -- everything
  1918. -- We need to recompile if M's exports change, because
  1919. -- if the import was import M, we might now have a name clash
  1920. -- in the importing module.
  1921. -- if the import was import M(x) M might no longer export x
  1922. -- The only way we don't depend on the export list is if we have
  1923. -- import M()
  1924. -- And of course, for modules that aren't imported directly we don't
  1925. -- depend on their export lists
  1926. instance Binary Usage where
  1927. put_ bh usg@UsagePackageModule{} = do
  1928. putByte bh 0
  1929. put_ bh (usg_mod usg)
  1930. put_ bh (usg_mod_hash usg)
  1931. put_ bh (usg_safe usg)
  1932. put_ bh usg@UsageHomeModule{} = do
  1933. putByte bh 1
  1934. put_ bh (usg_mod_name usg)
  1935. put_ bh (usg_mod_hash usg)
  1936. put_ bh (usg_exports usg)
  1937. put_ bh (usg_entities usg)
  1938. put_ bh (usg_safe usg)
  1939. put_ bh usg@UsageFile{} = do
  1940. putByte bh 2
  1941. put_ bh (usg_file_path usg)
  1942. put_ bh (usg_file_hash usg)
  1943. get bh = do
  1944. h <- getByte bh
  1945. case h of
  1946. 0 -> do
  1947. nm <- get bh
  1948. mod <- get bh
  1949. safe <- get bh
  1950. return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
  1951. 1 -> do
  1952. nm <- get bh
  1953. mod <- get bh
  1954. exps <- get bh
  1955. ents <- get bh
  1956. safe <- get bh
  1957. return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
  1958. usg_exports = exps, usg_entities = ents, usg_safe = safe }
  1959. 2 -> do
  1960. fp <- get bh
  1961. hash <- get bh
  1962. return UsageFile { usg_file_path = fp, usg_file_hash = hash }
  1963. i -> error ("Binary.get(Usage): " ++ show i)
  1964. {-
  1965. ************************************************************************
  1966. * *
  1967. The External Package State
  1968. * *
  1969. ************************************************************************
  1970. -}
  1971. type PackageTypeEnv = TypeEnv
  1972. type PackageRuleBase = RuleBase
  1973. type PackageInstEnv = InstEnv
  1974. type PackageFamInstEnv = FamInstEnv
  1975. type PackageVectInfo = VectInfo
  1976. type PackageAnnEnv = AnnEnv
  1977. -- | Information about other packages that we have slurped in by reading
  1978. -- their interface files
  1979. data ExternalPackageState
  1980. = EPS {
  1981. eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
  1982. -- ^ In OneShot mode (only), home-package modules
  1983. -- accumulate in the external package state, and are
  1984. -- sucked in lazily. For these home-pkg modules
  1985. -- (only) we need to record which are boot modules.
  1986. -- We set this field after loading all the
  1987. -- explicitly-imported interfaces, but before doing
  1988. -- anything else
  1989. --
  1990. -- The 'ModuleName' part is not necessary, but it's useful for
  1991. -- debug prints, and it's convenient because this field comes
  1992. -- direct from 'TcRnTypes.imp_dep_mods'
  1993. eps_PIT :: !PackageIfaceTable,
  1994. -- ^ The 'ModIface's for modules in external packages
  1995. -- whose interfaces we have opened.
  1996. -- The declarations in these interface files are held in the
  1997. -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'
  1998. -- fields of this record, not in the 'mi_decls' fields of the
  1999. -- interface we have sucked in.
  2000. --
  2001. -- What /is/ in the PIT is:
  2002. --
  2003. -- * The Module
  2004. --
  2005. -- * Fingerprint info
  2006. --
  2007. -- * Its exports
  2008. --
  2009. -- * Fixities
  2010. --
  2011. -- * Deprecations and warnings
  2012. eps_PTE :: !PackageTypeEnv,
  2013. -- ^ Result of typechecking all the external package
  2014. -- interface files we have sucked in. The domain of
  2015. -- the mapping is external-package modules
  2016. eps_inst_env :: !PackageInstEnv, -- ^ The total 'InstEnv' accumulated
  2017. -- from all the external-package modules
  2018. eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated
  2019. -- from all the external-package modules
  2020. eps_rule_base :: !PackageRuleBase, -- ^ The total 'RuleEnv' accumulated
  2021. -- from all the external-package modules
  2022. eps_vect_info :: !PackageVectInfo, -- ^ The total 'VectInfo' accumulated
  2023. -- from all the external-package modules
  2024. eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated
  2025. -- from all the external-package modules
  2026. eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
  2027. -- packages, keyed off the module that declared them
  2028. eps_stats :: !EpsStats -- ^ Stastics about what was loaded from external packages
  2029. }
  2030. -- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.
  2031. -- \"In\" means stuff that is just /read/ from interface files,
  2032. -- \"Out\" means actually sucked in and type-checked
  2033. data EpsStats = EpsStats { n_ifaces_in
  2034. , n_decls_in, n_decls_out
  2035. , n_rules_in, n_rules_out
  2036. , n_insts_in, n_insts_out :: !Int }
  2037. addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
  2038. -- ^ Add stats for one newly-read interface
  2039. addEpsInStats stats n_decls n_insts n_rules
  2040. = stats { n_ifaces_in = n_ifaces_in stats + 1
  2041. , n_decls_in = n_decls_in stats + n_decls
  2042. , n_insts_in = n_insts_in stats + n_insts
  2043. , n_rules_in = n_rules_in stats + n_rules }
  2044. {-
  2045. Names in a NameCache are always stored as a Global, and have the SrcLoc
  2046. of their binding locations.
  2047. Actually that's not quite right. When we first encounter the original
  2048. name, we might not be at its binding site (e.g. we are reading an
  2049. interface file); so we give it 'noSrcLoc' then. Later, when we find
  2050. its binding site, we fix it up.
  2051. -}
  2052. -- | The NameCache makes sure that there is just one Unique assigned for
  2053. -- each original name; i.e. (module-name, occ-name) pair and provides
  2054. -- something of a lookup mechanism for those names.
  2055. data NameCache
  2056. = NameCache { nsUniqs :: !UniqSupply,
  2057. -- ^ Supply of uniques
  2058. nsNames :: !OrigNameCache
  2059. -- ^ Ensures that one original name gets one unique
  2060. }
  2061. updNameCacheIO :: HscEnv
  2062. -> (NameCache -> (NameCache, c)) -- The updating function
  2063. -> IO c
  2064. updNameCacheIO hsc_env upd_fn
  2065. = atomicModifyIORef' (hsc_NC hsc_env) upd_fn
  2066. -- | Per-module cache of original 'OccName's given 'Name's
  2067. type OrigNameCache = ModuleEnv (OccEnv Name)
  2068. mkSOName :: Platform -> FilePath -> FilePath
  2069. mkSOName platform root
  2070. = case platformOS platform of
  2071. OSDarwin -> ("lib" ++ root) <.> "dylib"
  2072. OSMinGW32 -> root <.> "dll"
  2073. _ -> ("lib" ++ root) <.> "so"
  2074. mkHsSOName :: Platform -> FilePath -> FilePath
  2075. mkHsSOName platform root = ("lib" ++ root) <.> soExt platform
  2076. soExt :: Platform -> FilePath
  2077. soExt platform
  2078. = case platformOS platform of
  2079. OSDarwin -> "dylib"
  2080. OSMinGW32 -> "dll"
  2081. _ -> "so"
  2082. {-
  2083. ************************************************************************
  2084. * *
  2085. The module graph and ModSummary type
  2086. A ModSummary is a node in the compilation manager's
  2087. dependency graph, and it's also passed to hscMain
  2088. * *
  2089. ************************************************************************
  2090. -}
  2091. -- | A ModuleGraph contains all the nodes from the home package (only).
  2092. -- There will be a node for each source module, plus a node for each hi-boot
  2093. -- module.
  2094. --
  2095. -- The graph is not necessarily stored in topologically-sorted order. Use
  2096. -- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.
  2097. type ModuleGraph = [ModSummary]
  2098. emptyMG :: ModuleGraph
  2099. emptyMG = []
  2100. -- | A single node in a 'ModuleGraph'. The nodes of the module graph
  2101. -- are one of:
  2102. --
  2103. -- * A regular Haskell source module
  2104. -- * A hi-boot source module
  2105. --
  2106. data ModSummary
  2107. = ModSummary {
  2108. ms_mod :: Module,
  2109. -- ^ Identity of the module
  2110. ms_hsc_src :: HscSource,
  2111. -- ^ The module source either plain Haskell or hs-boot
  2112. ms_location :: ModLocation,
  2113. -- ^ Location of the various files belonging to the module
  2114. ms_hs_date :: UTCTime,
  2115. -- ^ Timestamp of source file
  2116. ms_obj_date :: Maybe UTCTime,
  2117. -- ^ Timestamp of object, if we have one
  2118. ms_iface_date :: Maybe UTCTime,
  2119. -- ^ Timestamp of hi file, if we *only* are typechecking (it is
  2120. -- 'Nothing' otherwise.
  2121. -- See Note [Recompilation checking when typechecking only] and #9243
  2122. ms_srcimps :: [(Maybe FastString, Located ModuleName)],
  2123. -- ^ Source imports of the module
  2124. ms_textual_imps :: [(Maybe FastString, Located ModuleName)],
  2125. -- ^ Non-source imports of the module from the module *text*
  2126. ms_hspp_file :: FilePath,
  2127. -- ^ Filename of preprocessed source file
  2128. ms_hspp_opts :: DynFlags,
  2129. -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@
  2130. -- pragmas in the modules source code
  2131. ms_hspp_buf :: Maybe StringBuffer
  2132. -- ^ The actual preprocessed source, if we have it
  2133. }
  2134. ms_mod_name :: ModSummary -> ModuleName
  2135. ms_mod_name = moduleName . ms_mod
  2136. ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
  2137. ms_imps ms =
  2138. ms_textual_imps ms ++
  2139. map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))
  2140. where
  2141. mk_additional_import mod_nm = (Nothing, noLoc mod_nm)
  2142. -- The ModLocation contains both the original source filename and the
  2143. -- filename of the cleaned-up source file after all preprocessing has been
  2144. -- done. The point is that the summariser will have to cpp/unlit/whatever
  2145. -- all files anyway, and there's no point in doing this twice -- just
  2146. -- park the result in a temp file, put the name of it in the location,
  2147. -- and let @compile@ read from that file on the way back up.
  2148. -- The ModLocation is stable over successive up-sweeps in GHCi, wheres
  2149. -- the ms_hs_date and imports can, of course, change
  2150. msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
  2151. msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
  2152. msHiFilePath ms = ml_hi_file (ms_location ms)
  2153. msObjFilePath ms = ml_obj_file (ms_location ms)
  2154. -- | Did this 'ModSummary' originate from a hs-boot file?
  2155. isBootSummary :: ModSummary -> Bool
  2156. isBootSummary ms = ms_hsc_src ms == HsBootFile
  2157. instance Outputable ModSummary where
  2158. ppr ms
  2159. = sep [text "ModSummary {",
  2160. nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
  2161. text "ms_mod =" <+> ppr (ms_mod ms)
  2162. <> text (hscSourceString (ms_hsc_src ms)) <> comma,
  2163. text "ms_textual_imps =" <+> ppr (ms_textual_imps ms),
  2164. text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
  2165. char '}'
  2166. ]
  2167. showModMsg :: DynFlags -> HscTarget -> Bool -> ModSummary -> String
  2168. showModMsg dflags target recomp mod_summary
  2169. = showSDoc dflags $
  2170. hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
  2171. char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
  2172. case target of
  2173. HscInterpreted | recomp
  2174. -> text "interpreted"
  2175. HscNothing -> text "nothing"
  2176. _ | HsigFile == ms_hsc_src mod_summary -> text "nothing"
  2177. | otherwise -> text (normalise $ msObjFilePath mod_summary),
  2178. char ')']
  2179. where
  2180. mod = moduleName (ms_mod mod_summary)
  2181. mod_str = showPpr dflags mod
  2182. ++ hscSourceString' dflags mod (ms_hsc_src mod_summary)
  2183. -- | Variant of hscSourceString which prints more information for signatures.
  2184. -- This can't live in DriverPhases because this would cause a module loop.
  2185. hscSourceString' :: DynFlags -> ModuleName -> HscSource -> String
  2186. hscSourceString' _ _ HsSrcFile = ""
  2187. hscSourceString' _ _ HsBootFile = "[boot]"
  2188. hscSourceString' dflags mod HsigFile =
  2189. "[" ++ (maybe "abstract sig"
  2190. (("sig of "++).showPpr dflags)
  2191. (getSigOf dflags mod)) ++ "]"
  2192. -- NB: -sig-of could be missing if we're just typechecking
  2193. {-
  2194. ************************************************************************
  2195. * *
  2196. \subsection{Recmpilation}
  2197. * *
  2198. ************************************************************************
  2199. -}
  2200. -- | Indicates whether a given module's source has been modified since it
  2201. -- was last compiled.
  2202. data SourceModified
  2203. = SourceModified
  2204. -- ^ the source has been modified
  2205. | SourceUnmodified
  2206. -- ^ the source has not been modified. Compilation may or may
  2207. -- not be necessary, depending on whether any dependencies have
  2208. -- changed since we last compiled.
  2209. | SourceUnmodifiedAndStable
  2210. -- ^ the source has not been modified, and furthermore all of
  2211. -- its (transitive) dependencies are up to date; it definitely
  2212. -- does not need to be recompiled. This is important for two
  2213. -- reasons: (a) we can omit the version check in checkOldIface,
  2214. -- and (b) if the module used TH splices we don't need to force
  2215. -- recompilation.
  2216. {-
  2217. ************************************************************************
  2218. * *
  2219. \subsection{Hpc Support}
  2220. * *
  2221. ************************************************************************
  2222. -}
  2223. -- | Information about a modules use of Haskell Program Coverage
  2224. data HpcInfo
  2225. = HpcInfo
  2226. { hpcInfoTickCount :: Int
  2227. , hpcInfoHash :: Int
  2228. }
  2229. | NoHpcInfo
  2230. { hpcUsed :: AnyHpcUsage -- ^ Is hpc used anywhere on the module \*tree\*?
  2231. }
  2232. -- | This is used to signal if one of my imports used HPC instrumentation
  2233. -- even if there is no module-local HPC usage
  2234. type AnyHpcUsage = Bool
  2235. emptyHpcInfo :: AnyHpcUsage -> HpcInfo
  2236. emptyHpcInfo = NoHpcInfo
  2237. -- | Find out if HPC is used by this module or any of the modules
  2238. -- it depends upon
  2239. isHpcUsed :: HpcInfo -> AnyHpcUsage
  2240. isHpcUsed (HpcInfo {}) = True
  2241. isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
  2242. {-
  2243. ************************************************************************
  2244. * *
  2245. \subsection{Vectorisation Support}
  2246. * *
  2247. ************************************************************************
  2248. The following information is generated and consumed by the vectorisation
  2249. subsystem. It communicates the vectorisation status of declarations from one
  2250. module to another.
  2251. Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
  2252. below? We need to know `f' when converting to IfaceVectInfo. However, during
  2253. vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
  2254. on just the OccName easily in a Core pass.
  2255. -}
  2256. -- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
  2257. -- documentation at 'Vectorise.Env.GlobalEnv'.
  2258. --
  2259. -- NB: The following tables may also include 'Var's, 'TyCon's and 'DataCon's from imported modules,
  2260. -- which have been subsequently vectorised in the current module.
  2261. --
  2262. data VectInfo
  2263. = VectInfo
  2264. { vectInfoVar :: DVarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
  2265. , vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@
  2266. , vectInfoDataCon :: NameEnv (DataCon, DataCon) -- ^ @(C, C_v)@ keyed on @C@
  2267. , vectInfoParallelVars :: DVarSet -- ^ set of parallel variables
  2268. , vectInfoParallelTyCons :: NameSet -- ^ set of parallel type constructors
  2269. }
  2270. -- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
  2271. -- across module boundaries.
  2272. --
  2273. -- NB: The field 'ifaceVectInfoVar' explicitly contains the workers of data constructors as well as
  2274. -- class selectors — i.e., their mappings are /not/ implicitly generated from the data types.
  2275. -- Moreover, whether the worker of a data constructor is in 'ifaceVectInfoVar' determines
  2276. -- whether that data constructor was vectorised (or is part of an abstractly vectorised type
  2277. -- constructor).
  2278. --
  2279. data IfaceVectInfo
  2280. = IfaceVectInfo
  2281. { ifaceVectInfoVar :: [Name] -- ^ All variables in here have a vectorised variant
  2282. , ifaceVectInfoTyCon :: [Name] -- ^ All 'TyCon's in here have a vectorised variant;
  2283. -- the name of the vectorised variant and those of its
  2284. -- data constructors are determined by
  2285. -- 'OccName.mkVectTyConOcc' and
  2286. -- 'OccName.mkVectDataConOcc'; the names of the
  2287. -- isomorphisms are determined by 'OccName.mkVectIsoOcc'
  2288. , ifaceVectInfoTyConReuse :: [Name] -- ^ The vectorised form of all the 'TyCon's in here
  2289. -- coincides with the unconverted form; the name of the
  2290. -- isomorphisms is determined by 'OccName.mkVectIsoOcc'
  2291. , ifaceVectInfoParallelVars :: [Name] -- iface version of 'vectInfoParallelVar'
  2292. , ifaceVectInfoParallelTyCons :: [Name] -- iface version of 'vectInfoParallelTyCon'
  2293. }
  2294. noVectInfo :: VectInfo
  2295. noVectInfo
  2296. = VectInfo emptyDVarEnv emptyNameEnv emptyNameEnv emptyDVarSet emptyNameSet
  2297. plusVectInfo :: VectInfo -> VectInfo -> VectInfo
  2298. plusVectInfo vi1 vi2 =
  2299. VectInfo (vectInfoVar vi1 `plusDVarEnv` vectInfoVar vi2)
  2300. (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
  2301. (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
  2302. (vectInfoParallelVars vi1 `unionDVarSet` vectInfoParallelVars vi2)
  2303. (vectInfoParallelTyCons vi1 `unionNameSet` vectInfoParallelTyCons vi2)
  2304. concatVectInfo :: [VectInfo] -> VectInfo
  2305. concatVectInfo = foldr plusVectInfo noVectInfo
  2306. noIfaceVectInfo :: IfaceVectInfo
  2307. noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
  2308. isNoIfaceVectInfo :: IfaceVectInfo -> Bool
  2309. isNoIfaceVectInfo (IfaceVectInfo l1 l2 l3 l4 l5)
  2310. = null l1 && null l2 && null l3 && null l4 && null l5
  2311. instance Outputable VectInfo where
  2312. ppr info = vcat
  2313. [ text "variables :" <+> ppr (vectInfoVar info)
  2314. , text "tycons :" <+> ppr (vectInfoTyCon info)
  2315. , text "datacons :" <+> ppr (vectInfoDataCon info)
  2316. , text "parallel vars :" <+> ppr (vectInfoParallelVars info)
  2317. , text "parallel tycons :" <+> ppr (vectInfoParallelTyCons info)
  2318. ]
  2319. instance Outputable IfaceVectInfo where
  2320. ppr info = vcat
  2321. [ text "variables :" <+> ppr (ifaceVectInfoVar info)
  2322. , text "tycons :" <+> ppr (ifaceVectInfoTyCon info)
  2323. , text "tycons reuse :" <+> ppr (ifaceVectInfoTyConReuse info)
  2324. , text "parallel vars :" <+> ppr (ifaceVectInfoParallelVars info)
  2325. , text "parallel tycons :" <+> ppr (ifaceVectInfoParallelTyCons info)
  2326. ]
  2327. instance Binary IfaceVectInfo where
  2328. put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do
  2329. put_ bh a1
  2330. put_ bh a2
  2331. put_ bh a3
  2332. put_ bh a4
  2333. put_ bh a5
  2334. get bh = do
  2335. a1 <- get bh
  2336. a2 <- get bh
  2337. a3 <- get bh
  2338. a4 <- get bh
  2339. a5 <- get bh
  2340. return (IfaceVectInfo a1 a2 a3 a4 a5)
  2341. {-
  2342. ************************************************************************
  2343. * *
  2344. \subsection{Safe Haskell Support}
  2345. * *
  2346. ************************************************************************
  2347. This stuff here is related to supporting the Safe Haskell extension,
  2348. primarily about storing under what trust type a module has been compiled.
  2349. -}
  2350. -- | Is an import a safe import?
  2351. type IsSafeImport = Bool
  2352. -- | Safe Haskell information for 'ModIface'
  2353. -- Simply a wrapper around SafeHaskellMode to sepperate iface and flags
  2354. newtype IfaceTrustInfo = TrustInfo SafeHaskellMode
  2355. getSafeMode :: IfaceTrustInfo -> SafeHaskellMode
  2356. getSafeMode (TrustInfo x) = x
  2357. setSafeMode :: SafeHaskellMode -> IfaceTrustInfo
  2358. setSafeMode = TrustInfo
  2359. noIfaceTrustInfo :: IfaceTrustInfo
  2360. noIfaceTrustInfo = setSafeMode Sf_None
  2361. trustInfoToNum :: IfaceTrustInfo -> Word8
  2362. trustInfoToNum it
  2363. = case getSafeMode it of
  2364. Sf_None -> 0
  2365. Sf_Unsafe -> 1
  2366. Sf_Trustworthy -> 2
  2367. Sf_Safe -> 3
  2368. numToTrustInfo :: Word8 -> IfaceTrustInfo
  2369. numToTrustInfo 0 = setSafeMode Sf_None
  2370. numToTrustInfo 1 = setSafeMode Sf_Unsafe
  2371. numToTrustInfo 2 = setSafeMode Sf_Trustworthy
  2372. numToTrustInfo 3 = setSafeMode Sf_Safe
  2373. numToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used
  2374. -- to be Sf_SafeInfered but we no longer
  2375. -- differentiate.
  2376. numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"
  2377. instance Outputable IfaceTrustInfo where
  2378. ppr (TrustInfo Sf_None) = text "none"
  2379. ppr (TrustInfo Sf_Unsafe) = text "unsafe"
  2380. ppr (TrustInfo Sf_Trustworthy) = text "trustworthy"
  2381. ppr (TrustInfo Sf_Safe) = text "safe"
  2382. instance Binary IfaceTrustInfo where
  2383. put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
  2384. get bh = getByte bh >>= (return . numToTrustInfo)
  2385. {-
  2386. ************************************************************************
  2387. * *
  2388. \subsection{Parser result}
  2389. * *
  2390. ************************************************************************
  2391. -}
  2392. data HsParsedModule = HsParsedModule {
  2393. hpm_module :: Located (HsModule RdrName),
  2394. hpm_src_files :: [FilePath],
  2395. -- ^ extra source files (e.g. from #includes). The lexer collects
  2396. -- these from '# <file> <line>' pragmas, which the C preprocessor
  2397. -- leaves behind. These files and their timestamps are stored in
  2398. -- the .hi file, so that we can force recompilation if any of
  2399. -- them change (#3589)
  2400. hpm_annotations :: ApiAnns
  2401. -- See note [Api annotations] in ApiAnnotation.hs
  2402. }
  2403. {-
  2404. ************************************************************************
  2405. * *
  2406. \subsection{Linkable stuff}
  2407. * *
  2408. ************************************************************************
  2409. This stuff is in here, rather than (say) in Linker.hs, because the Linker.hs
  2410. stuff is the *dynamic* linker, and isn't present in a stage-1 compiler
  2411. -}
  2412. -- | Information we can use to dynamically link modules into the compiler
  2413. data Linkable = LM {
  2414. linkableTime :: UTCTime, -- ^ Time at which this linkable was built
  2415. -- (i.e. when the bytecodes were produced,
  2416. -- or the mod date on the files)
  2417. linkableModule :: Module, -- ^ The linkable module itself
  2418. linkableUnlinked :: [Unlinked]
  2419. -- ^ Those files and chunks of code we have yet to link.
  2420. --
  2421. -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.
  2422. -- If this list is empty, the Linkable represents a fake linkable, which
  2423. -- is generated in HscNothing mode to avoid recompiling modules.
  2424. --
  2425. -- ToDo: Do items get removed from this list when they get linked?
  2426. }
  2427. isObjectLinkable :: Linkable -> Bool
  2428. isObjectLinkable l = not (null unlinked) && all isObject unlinked
  2429. where unlinked = linkableUnlinked l
  2430. -- A linkable with no Unlinked's is treated as a BCO. We can
  2431. -- generate a linkable with no Unlinked's as a result of
  2432. -- compiling a module in HscNothing mode, and this choice
  2433. -- happens to work well with checkStability in module GHC.
  2434. linkableObjs :: Linkable -> [FilePath]
  2435. linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
  2436. instance Outputable Linkable where
  2437. ppr (LM when_made mod unlinkeds)
  2438. = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
  2439. $$ nest 3 (ppr unlinkeds)
  2440. -------------------------------------------
  2441. -- | Objects which have yet to be linked by the compiler
  2442. data Unlinked
  2443. = DotO FilePath -- ^ An object file (.o)
  2444. | DotA FilePath -- ^ Static archive file (.a)
  2445. | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib)
  2446. | BCOs CompiledByteCode -- ^ A byte-code object, lives only in memory
  2447. #ifndef GHCI
  2448. data CompiledByteCode = CompiledByteCodeUndefined
  2449. _unusedCompiledByteCode :: CompiledByteCode
  2450. _unusedCompiledByteCode = CompiledByteCodeUndefined
  2451. data ModBreaks = ModBreaksUndefined
  2452. emptyModBreaks :: ModBreaks
  2453. emptyModBreaks = ModBreaksUndefined
  2454. #endif
  2455. instance Outputable Unlinked where
  2456. ppr (DotO path) = text "DotO" <+> text path
  2457. ppr (DotA path) = text "DotA" <+> text path
  2458. ppr (DotDLL path) = text "DotDLL" <+> text path
  2459. #ifdef GHCI
  2460. ppr (BCOs bcos) = text "BCOs" <+> ppr bcos
  2461. #else
  2462. ppr (BCOs _) = text "No byte code"
  2463. #endif
  2464. -- | Is this an actual file on disk we can link in somehow?
  2465. isObject :: Unlinked -> Bool
  2466. isObject (DotO _) = True
  2467. isObject (DotA _) = True
  2468. isObject (DotDLL _) = True
  2469. isObject _ = False
  2470. -- | Is this a bytecode linkable with no file on disk?
  2471. isInterpretable :: Unlinked -> Bool
  2472. isInterpretable = not . isObject
  2473. -- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object
  2474. nameOfObject :: Unlinked -> FilePath
  2475. nameOfObject (DotO fn) = fn
  2476. nameOfObject (DotA fn) = fn
  2477. nameOfObject (DotDLL fn) = fn
  2478. nameOfObject other = pprPanic "nameOfObject" (ppr other)
  2479. -- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
  2480. byteCodeOfObject :: Unlinked -> CompiledByteCode
  2481. byteCodeOfObject (BCOs bc) = bc
  2482. byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)