\section[HscTypes]{Types for the per-module compiler}
\begin{code}
+-- | Types for the per-module compiler
module HscTypes (
+ -- * 'Ghc' monad stuff
+ Ghc(..), GhcT(..), liftGhcT,
+ GhcMonad(..), WarnLogMonad(..),
+ liftIO,
+ ioMsgMaybe, ioMsg,
+ logWarnings, clearWarnings, hasWarnings,
+ SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
+ handleSourceError,
+ reflectGhc, reifyGhc,
+
-- * Sessions and compilation state
- Session(..), HscEnv(..), hscEPS,
+ Session(..), withSession, modifySession,
+ HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
+ -- * Information about modules
ModDetails(..), emptyModDetails,
- ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+ ModGuts(..), CoreModule(..), CgGuts(..), ForeignStubs(..),
+ ImportedMods,
- ModSummary(..), showModMsg, isBootSummary,
- msHsFilePath, msHiFilePath, msObjFilePath,
+ ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
+ msHsFilePath, msHiFilePath, msObjFilePath,
+ -- * Information about the module being compiled
HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
+ -- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules,
-
+ hptInstances, hptRules, hptVectInfo,
+
+ -- * State relating to known packages
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIfaceByModule, emptyModIface,
+
+ PackageInstEnv, PackageRuleBase,
+ -- * Interactive context
InteractiveContext(..), emptyInteractiveContext,
- icPrintUnqual, mkPrintUnqualified,
-
- ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
- emptyIfaceDepCache,
+ icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
+ substInteractiveContext,
- Deprecs(..), IfaceDeprecs,
+ -- * Interfaces
+ ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
+ emptyIfaceWarnCache,
+ -- * Fixity
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
+ -- * TyThings and type environments
+ TyThing(..),
+ tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
implicitTyThings, isImplicitTyThing,
-
- TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
- TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
+
+ TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
typeEnvDataCons,
+ -- * MonadThings
+ MonadThings(..),
+
+ -- * Information on imports and exports
WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
NameCache(..), OrigNameCache, OrigIParamCache,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
- Deprecations, DeprecTxt, plusDeprecs,
-
- PackageInstEnv, PackageRuleBase,
+ -- * Warnings
+ Warnings(..), WarningTxt(..), plusWarns,
- -- Linker stuff
+ -- * Linker stuff
Linkable(..), isObjectLinkable,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
- HpcInfo, noHpcInfo
+
+ -- * Program coverage
+ HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
+
+ -- * Breakpoints
+ ModBreaks (..), BreakIndex, emptyModBreaks,
+
+ -- * Vectorisation information
+ VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
+ noIfaceVectInfo
) where
#include "HsVersions.h"
-import Breakpoints ( SiteNumber, Coord, noDbgSites )
#ifdef GHCI
import ByteCodeAsm ( CompiledByteCode )
+import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
-import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv,
- LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..),
- unQualOK, ImpDeclSpec(..), Provenance(..),
- ImportSpec(..), lookupGlobalRdrEnv )
-import Name ( Name, NamedThing, getName, nameOccName, nameModule )
+import RdrName
+import Name
import NameEnv
import NameSet
import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
import FamInstEnv ( FamInstEnv, FamInst )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
-import Id ( Id, isImplicitId )
-import Type ( TyThing(..) )
+import VarEnv
+import VarSet
+import Var
+import Id
+import Type
import Class ( Class, classSelIds, classATs, classTyCon )
import TyCon
-import DataCon ( DataCon, dataConImplicitIds )
+import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
-import Packages ( PackageId )
-import DynFlags ( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) )
+import Packages hiding ( Version(..) )
+import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes ( Version, initialVersion, IPName,
- Fixity, defaultFixity, DeprecTxt )
+import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) )
+import OptimizationFuel ( OptFuelState )
import IfaceSyn
import FiniteMap ( FiniteMap )
import CoreSyn ( CoreRule )
-import Maybes ( orElse, expectJust, catMaybes, seqMaybe )
+import Maybes ( orElse, expectJust, catMaybes )
import Outputable
+import BreakArray
import SrcLoc ( SrcSpan, Located )
-import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
+import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
-import FastString ( FastString )
-
+import FastString
import StringBuffer ( StringBuffer )
+import Fingerprint
+import MonadUtils
+import Bag ( emptyBag, unionBags, isEmptyBag )
+import Data.Dynamic ( Typeable )
+import qualified Data.Dynamic as Dyn
+#if __GLASGOW_HASKELL__ < 609
+import Data.Dynamic ( toDyn, fromDyn, fromDynamic )
+#else
+import Bag ( bagToList )
+#endif
+import ErrUtils ( ErrorMessages, WarningMessages, Messages )
+import System.FilePath
import System.Time ( ClockTime )
-import Data.IORef ( IORef, readIORef )
+import Data.IORef
+import Data.Array ( Array, array )
+import Data.List
+import Control.Monad ( mplus, guard, liftM )
+import Exception
\end{code}
-- session. A compilation session consists of a set of modules
-- constituting the current program or library, the context for
-- interactive evaluation, and various caches.
-newtype Session = Session (IORef HscEnv)
-\end{code}
+data Session = Session !(IORef HscEnv) !(IORef WarningMessages)
+
+mkSrcErr :: ErrorMessages -> SourceError
+srcErrorMessages :: SourceError -> ErrorMessages
+mkApiErr :: SDoc -> GhcApiError
+
+#if __GLASGOW_HASKELL__ >= 609
+
+-- | A source error is an error that is caused by one or more errors in the
+-- source code. A 'SourceError' is thrown by many functions in the
+-- compilation pipeline. Inside GHC these errors are merely printed via
+-- 'log_action', but API clients may treat them differently, for example,
+-- insert them into a list box. If you want the default behaviour, use the
+-- idiom:
+--
+-- > handleSourceError printExceptionAndWarnings $ do
+-- > ... api calls that may fail ...
+--
+-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
+-- This list may be empty if the compiler failed due to @-Werror@
+-- ('Opt_WarnIsError').
+--
+-- See 'printExceptionAndWarnings' for more information on what to take care
+-- of when writing a custom error handler.
+data SourceError = SourceError ErrorMessages
+
+instance Show SourceError where
+ show (SourceError msgs) = unlines . map show . bagToList $ msgs
+ -- ToDo: is there some nicer way to print this?
+
+sourceErrorTc :: Dyn.TyCon
+sourceErrorTc = Dyn.mkTyCon "SourceError"
+{-# NOINLINE sourceErrorTc #-}
+instance Typeable SourceError where
+ typeOf _ = Dyn.mkTyConApp sourceErrorTc []
+
+instance Exception SourceError
+
+mkSrcErr = SourceError
-HscEnv is like Session, except that some of the fields are immutable.
-An HscEnv is used to compile a single module from plain Haskell source
-code (after preprocessing) to either C, assembly or C--. Things like
-the module graph don't change during a single compilation.
+-- | Perform the given action and call the exception handler if the action
+-- throws a 'SourceError'. See 'SourceError' for more information.
+handleSourceError :: (ExceptionMonad m) =>
+ (SourceError -> m a) -- ^ exception handler
+ -> m a -- ^ action to perform
+ -> m a
+handleSourceError handler act =
+ gcatch act (\(e :: SourceError) -> handler e)
+
+srcErrorMessages (SourceError msgs) = msgs
+
+-- | XXX: what exactly is an API error?
+data GhcApiError = GhcApiError SDoc
+
+instance Show GhcApiError where
+ show (GhcApiError msg) = showSDoc msg
+
+ghcApiErrorTc :: Dyn.TyCon
+ghcApiErrorTc = Dyn.mkTyCon "GhcApiError"
+{-# NOINLINE ghcApiErrorTc #-}
+instance Typeable GhcApiError where
+ typeOf _ = Dyn.mkTyConApp ghcApiErrorTc []
+
+instance Exception GhcApiError
+
+mkApiErr = GhcApiError
+
+#else
+------------------------------------------------------------------------
+-- implementation for bootstrapping without extensible exceptions
+
+data SourceException = SourceException ErrorMessages
+sourceExceptionTc :: Dyn.TyCon
+sourceExceptionTc = Dyn.mkTyCon "SourceException"
+{-# NOINLINE sourceExceptionTc #-}
+instance Typeable SourceException where
+ typeOf _ = Dyn.mkTyConApp sourceExceptionTc []
+
+-- Source error has to look like a normal exception. Throwing a DynException
+-- directly would not allow us to use the Exception monad. We also cannot
+-- make it part of GhcException as that would lead to circular imports.
+
+type SourceError = Exception
+type GhcApiError = Exception
+
+mkSrcErr msgs = DynException . toDyn $ SourceException msgs
+
+mkApiErr = IOException . userError . showSDoc
+
+srcErrorMessages (DynException ms) =
+ let SourceException msgs = (fromDyn ms (panic "SourceException expected"))
+ in msgs
+srcErrorMessages _ = panic "SourceError expected"
+
+handleSourceError :: ExceptionMonad m => (Exception -> m a) -> m a -> m a
+handleSourceError handler act =
+ gcatch act
+ (\e -> case e of
+ DynException dyn
+ | Just (SourceException _) <- fromDynamic dyn
+ -> handler e
+ _ -> throw e)
+#endif
+
+-- | A monad that allows logging of warnings.
+class Monad m => WarnLogMonad m where
+ setWarnings :: WarningMessages -> m ()
+ getWarnings :: m WarningMessages
+
+logWarnings :: WarnLogMonad m => WarningMessages -> m ()
+logWarnings warns = do
+ warns0 <- getWarnings
+ setWarnings (unionBags warns warns0)
+
+-- | Clear the log of 'Warnings'.
+clearWarnings :: WarnLogMonad m => m ()
+clearWarnings = setWarnings emptyBag
+
+-- | Returns true if there were any warnings.
+hasWarnings :: WarnLogMonad m => m Bool
+hasWarnings = getWarnings >>= return . not . isEmptyBag
+
+-- | A monad that has all the features needed by GHC API calls.
+--
+-- In short, a GHC monad
+--
+-- - allows embedding of IO actions,
+--
+-- - can log warnings,
+--
+-- - allows handling of (extensible) exceptions, and
+--
+-- - maintains a current session.
+--
+-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
+-- before any call to the GHC API functions can occur.
+--
+class (Functor m, MonadIO m, WarnLogMonad m, ExceptionMonad m)
+ => GhcMonad m where
+ getSession :: m HscEnv
+ setSession :: HscEnv -> m ()
+
+-- | Call the argument with the current session.
+withSession :: GhcMonad m => (HscEnv -> m a) -> m a
+withSession f = getSession >>= f
+
+-- | Set the current session to the result of applying the current session to
+-- the argument.
+modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
+modifySession f = do h <- getSession
+ setSession $! f h
+
+-- | A minimal implementation of a 'GhcMonad'. If you need a custom monad,
+-- e.g., to maintain additional state consider wrapping this monad or using
+-- 'GhcT'.
+newtype Ghc a = Ghc { unGhc :: Session -> IO a }
+
+instance Functor Ghc where
+ fmap f m = Ghc $ \s -> f `fmap` unGhc m s
+
+instance Monad Ghc where
+ return a = Ghc $ \_ -> return a
+ m >>= g = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s
+
+instance MonadIO Ghc where
+ liftIO ioA = Ghc $ \_ -> ioA
+
+instance ExceptionMonad Ghc where
+ gcatch act handle =
+ Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
+#if __GLASGOW_HASKELL__ < 609
+ gcatchDyn act handler =
+ Ghc $ \s -> unGhc act s `gcatchDyn` \e -> unGhc (handler e) s
+#endif
+instance WarnLogMonad Ghc where
+ setWarnings warns = Ghc $ \(Session _ wref) -> writeIORef wref warns
+ -- | Return 'Warnings' accumulated so far.
+ getWarnings = Ghc $ \(Session _ wref) -> readIORef wref
+
+instance GhcMonad Ghc where
+ getSession = Ghc $ \(Session r _) -> readIORef r
+ setSession s' = Ghc $ \(Session r _) -> writeIORef r s'
+
+-- | A monad transformer to add GHC specific features to another monad.
+--
+-- Note that the wrapped monad must support IO and handling of exceptions.
+newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
+liftGhcT :: Monad m => m a -> GhcT m a
+liftGhcT m = GhcT $ \_ -> m
+
+instance Functor m => Functor (GhcT m) where
+ fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
+
+instance Monad m => Monad (GhcT m) where
+ return x = GhcT $ \_ -> return x
+ m >>= k = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
+
+instance MonadIO m => MonadIO (GhcT m) where
+ liftIO ioA = GhcT $ \_ -> liftIO ioA
+
+instance ExceptionMonad m => ExceptionMonad (GhcT m) where
+ gcatch act handle =
+ GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
+#if __GLASGOW_HASKELL__ < 609
+ gcatchDyn _act _handler = error "cannot use GhcT in stage1"
+#endif
-Historical note: "hsc" used to be the name of the compiler binary,
-when there was a separate driver and compiler. To compile a single
-module, the driver would invoke hsc on the source code... so nowadays
-we think of hsc as the layer of the compiler that deals with compiling
-a single module.
+instance MonadIO m => WarnLogMonad (GhcT m) where
+ setWarnings warns = GhcT $ \(Session _ wref) -> liftIO $ writeIORef wref warns
+ -- | Return 'Warnings' accumulated so far.
+ getWarnings = GhcT $ \(Session _ wref) -> liftIO $ readIORef wref
+
+instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
+ getSession = GhcT $ \(Session r _) -> liftIO $ readIORef r
+ setSession s' = GhcT $ \(Session r _) -> liftIO $ writeIORef r s'
+
+-- | Lift an IO action returning errors messages into a 'GhcMonad'.
+--
+-- In order to reduce dependencies to other parts of the compiler, functions
+-- outside the "main" parts of GHC return warnings and errors as a parameter
+-- and signal success via by wrapping the result in a 'Maybe' type. This
+-- function logs the returned warnings and propagates errors as exceptions
+-- (of type 'SourceError').
+--
+-- This function assumes the following invariants:
+--
+-- 1. If the second result indicates success (is of the form 'Just x'),
+-- there must be no error messages in the first result.
+--
+-- 2. If there are no error messages, but the second result indicates failure
+-- there should be warnings in the first result. That is, if the action
+-- failed, it must have been due to the warnings (i.e., @-Werror@).
+ioMsgMaybe :: GhcMonad m =>
+ IO (Messages, Maybe a) -> m a
+ioMsgMaybe ioA = do
+ ((warns,errs), mb_r) <- liftIO ioA
+ logWarnings warns
+ case mb_r of
+ Nothing -> throw (mkSrcErr errs)
+ Just r -> ASSERT( isEmptyBag errs ) return r
+
+-- | Lift a non-failing IO action into a 'GhcMonad'.
+--
+-- Like 'ioMsgMaybe', but assumes that the action will never return any error
+-- messages.
+ioMsg :: GhcMonad m => IO (Messages, a) -> m a
+ioMsg ioA = do
+ ((warns,errs), r) <- liftIO ioA
+ logWarnings warns
+ ASSERT( isEmptyBag errs ) return r
+
+-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
+--
+-- You can use this to call functions returning an action in the 'Ghc' monad
+-- inside an 'IO' action. This is needed for some (too restrictive) callback
+-- arguments of some library functions:
+--
+-- > libFunc :: String -> (Int -> IO a) -> IO a
+-- > ghcFunc :: Int -> Ghc a
+-- >
+-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
+-- > ghcFuncUsingLibFunc str =
+-- > reifyGhc $ \s ->
+-- > libFunc $ \i -> do
+-- > reflectGhc (ghcFunc i) s
+--
+reflectGhc :: Ghc a -> Session -> IO a
+reflectGhc m = unGhc m
+
+-- > Dual to 'reflectGhc'. See its documentation.
+reifyGhc :: (Session -> IO a) -> Ghc a
+reifyGhc act = Ghc $ act
+\end{code}
\begin{code}
+-- | HscEnv is like 'Session', except that some of the fields are immutable.
+-- An HscEnv is used to compile a single module from plain Haskell source
+-- code (after preprocessing) to either C, assembly or C--. Things like
+-- the module graph don't change during a single compilation.
+--
+-- Historical note: \"hsc\" used to be the name of the compiler binary,
+-- when there was a separate driver and compiler. To compile a single
+-- module, the driver would invoke hsc on the source code... so nowadays
+-- we think of hsc as the layer of the compiler that deals with compiling
+-- a single module.
data HscEnv
= HscEnv {
hsc_dflags :: DynFlags,
- -- The dynamic flag settings
+ -- ^ The dynamic flag settings
hsc_targets :: [Target],
- -- The targets (or roots) of the current session
+ -- ^ The targets (or roots) of the current session
hsc_mod_graph :: ModuleGraph,
- -- The module graph of the current session
+ -- ^ The module graph of the current session
hsc_IC :: InteractiveContext,
- -- The context for evaluating interactive statements
+ -- ^ The context for evaluating interactive statements
hsc_HPT :: HomePackageTable,
- -- The home package table describes already-compiled
- -- home-packge modules, *excluding* the module we
+ -- ^ The home package table describes already-compiled
+ -- home-package modules, /excluding/ the module we
-- are compiling right now.
-- (In one-shot mode the current module is the only
-- home-package module, so hsc_HPT is empty. All other
- -- modules count as "external-package" modules.
+ -- modules count as \"external-package\" modules.
-- However, even in GHCi mode, hi-boot interfaces are
- -- demand-loadeded into the external-package table.)
+ -- demand-loaded into the external-package table.)
--
- -- hsc_HPT is not mutable because we only demand-load
+ -- 'hsc_HPT' is not mutable because we only demand-load
-- external packages; the home package is eagerly
-- loaded, module by module, by the compilation manager.
--
- -- The HPT may contain modules compiled earlier by --make
+ -- The HPT may contain modules compiled earlier by @--make@
-- but not actually below the current module in the dependency
- -- graph. (This changes a previous invariant: changed Jan 05.)
+ -- graph.
+
+ -- (This changes a previous invariant: changed Jan 05.)
hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
+ -- ^ Information about the currently loaded external packages.
+ -- This is mutable because packages will be demand-loaded during
+ -- a compilation run as required.
+
hsc_NC :: {-# UNPACK #-} !(IORef NameCache),
- -- These are side-effected by compiling to reflect
- -- sucking in interface files. They cache the state of
+ -- ^ As with 'hsc_EPS', this is side-effected by compiling to
+ -- reflect sucking in interface files. They cache the state of
-- external interface files, in effect.
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
+ -- ^ The cached result of performing finding in the file system
hsc_MLC :: {-# UNPACK #-} !(IORef ModLocationCache),
- -- The finder's cache. This caches the location of modules,
- -- so we don't have to search the filesystem multiple times.
+ -- ^ This caches the location of modules, so we don't have to
+ -- search the filesystem multiple times. See also 'hsc_FC'.
+
+ hsc_OptFuel :: OptFuelState,
+ -- ^ Settings to control the use of \"optimization fuel\":
+ -- by limiting the number of transformations,
+ -- we can use binary search to help find compiler bugs.
+
+ hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
+ -- ^ Used for one-shot compilation only, to initialise
+ -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
+ -- 'TcRunTypes.TcGblEnv'
hsc_global_rdr_env :: GlobalRdrEnv,
+ -- ^ A mapping from 'RdrName's that are in global scope during
+ -- the compilation of the current file to more detailed
+ -- information about those names. Not necessarily just the
+ -- names directly imported by the module being compiled!
+
hsc_global_type_env :: TypeEnv
+ -- ^ Typing information about all those things in global scope.
+ -- Not necessarily just the things directly imported by the module
+ -- being compiled!
}
hscEPS :: HscEnv -> IO ExternalPackageState
-- module. If so, use this instead of the file contents (this
-- is for use in an IDE where the file hasn't been saved by
-- the user yet).
-data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
+data Target = Target
+ TargetId -- module or filename
+ Bool -- object code allowed?
+ (Maybe (StringBuffer,ClockTime)) -- in-memory text buffer?
data TargetId
= TargetModule ModuleName
deriving Eq
pprTarget :: Target -> SDoc
-pprTarget (Target id _) = pprTargetId id
+pprTarget (Target id obj _) =
+ (if obj then char '*' else empty) <> pprTargetId id
instance Outputable Target where
ppr = pprTarget
+pprTargetId :: TargetId -> SDoc
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f _) = text f
instance Outputable TargetId where
ppr = pprTargetId
+-- | Helps us find information about modules in the home package
type HomePackageTable = ModuleNameEnv HomeModInfo
- -- Domain = modules in the home package
+ -- Domain = modules in the home package that have been fully compiled
-- "home" package name cached here for convenience
+
+-- | Helps us find information about modules in the imported packages
type PackageIfaceTable = ModuleEnv ModIface
-- Domain = modules in the imported packages
+emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable = emptyUFM
+
+emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable = emptyModuleEnv
+-- | Information about modules in the package being compiled
data HomeModInfo
- = HomeModInfo { hm_iface :: !ModIface,
- hm_details :: !ModDetails,
- hm_linkable :: !(Maybe Linkable) }
- -- hm_linkable might be Nothing if:
- -- a) this is an .hs-boot module
- -- b) temporarily during compilation if we pruned away
+ = HomeModInfo { hm_iface :: !ModIface, -- ^ The basic loaded interface file: every
+ -- loaded module has one of these, even if
+ -- it is imported from another package
+ hm_details :: !ModDetails, -- ^ Extra information that has been created
+ -- from the 'ModIface' for the module,
+ -- typically during typechecking
+ hm_linkable :: !(Maybe Linkable)
+ -- ^ The actual artifact we would like to link to access
+ -- things in this module.
+ --
+ -- 'hm_linkable' might be Nothing:
+ --
+ -- 1. If this is an .hs-boot module
+ --
+ -- 2. Temporarily during compilation if we pruned away
-- the old linkable because it was out of date.
- -- after a complete compilation (GHC.load), all hm_linkable
- -- fields in the HPT will be Just.
--
- -- When re-linking a module (hscNoRecomp), we construct
- -- the HomModInfo by building a new ModDetails from the
- -- old ModIface (only).
+ -- After a complete compilation ('GHC.load'), all 'hm_linkable'
+ -- fields in the 'HomePackageTable' will be @Just@.
+ --
+ -- When re-linking a module ('HscMain.HscNoRecomp'), we construct
+ -- the 'HomeModInfo' by building a new 'ModDetails' from the
+ -- old 'ModIface' (only).
+ }
--- | Find the 'ModIface' for a 'Module'
+-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
+-- and external package module information
lookupIfaceByModule
:: DynFlags
-> HomePackageTable
-- in the HPT. If it's not from the home package it's wrong to look
-- in the HPT, because the HPT is indexed by *ModuleName* not Module
fmap hm_iface (lookupUFM hpt (moduleName mod))
- `seqMaybe` lookupModuleEnv pit mod
+ `mplus` lookupModuleEnv pit mod
| otherwise = lookupModuleEnv pit mod -- Look in PIT only
-- (a) In OneShot mode, even home-package modules accumulate in the PIT
-- (b) Even in Batch (--make) mode, there is *one* case where a home-package
-- module is in the PIT, namely GHC.Prim when compiling the base package.
--- We could eliminate (b) if we wanted, by making GHC.Prim belong to a packake
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
-- of its own, but it doesn't seem worth the bother.
\end{code}
\begin{code}
-hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance]
--- Find all the instance declarations that are in modules imported
--- by this one, directly or indirectly, and are in the Home Package Table
--- This ensures that we don't see instances from modules --make compiled
--- before this one, but which are not below this one
+hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
+-- ^ Find all the instance declarations (of classes and families) that are in
+-- modules imported by this one, directly or indirectly, and are in the Home
+-- Package Table. This ensures that we don't see instances from modules @--make@
+-- compiled before this one, but which are not below this one.
hptInstances hsc_env want_this_module
- = [ ispec
- | mod_info <- eltsUFM (hsc_HPT hsc_env)
- , want_this_module (moduleName (mi_module (hm_iface mod_info)))
- , ispec <- md_insts (hm_details mod_info) ]
+ = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
+ guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
+ let details = hm_details mod_info
+ return (md_insts details, md_fam_insts details)
+ in (concat insts, concat famInsts)
+
+hptVectInfo :: HscEnv -> VectInfo
+-- ^ Get the combined VectInfo of all modules in the home package table. In
+-- contrast to instances and rules, we don't care whether the modules are
+-- \"below\" us in the dependency sense. The VectInfo of those modules not \"below\"
+-- us does not affect the compilation of the current module.
+hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
--- Get rules from modules "below" this one (in the dependency sense)
+-- ^ Get rules from modules \"below\" this one (in the dependency sense)
+hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
+
+hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
+hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))
+
+hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
+-- Get things from modules \"below\" this one (in the dependency sense)
-- C.f Inst.hptInstances
-hptRules hsc_env deps
- | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
+hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
+ | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
| otherwise
= let
hpt = hsc_HPT hsc_env
in
- [ rule
+ [ thing
| -- Find each non-hi-boot module below me
- (mod, False) <- deps
+ (mod, is_boot_mod) <- deps
+ , include_hi_boot || not is_boot_mod
-- unsavoury: when compiling the base package with --make, we
- -- sometimes try to look up RULES for GHC.Prim. GHC.Prim won't
+ -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't
-- be in the HPT, because we never compile it; it's in the EPT
-- instead. ToDo: clean up, and remove this slightly bogus
-- filter:
, mod /= moduleName gHC_PRIM
-- Look it up in the HPT
- , let rules = case lookupUFM hpt mod of
- Just info -> md_rules (hm_details info)
- Nothing -> pprTrace "WARNING in hptRules" msg []
- msg = vcat [ptext SLIT("missing module") <+> ppr mod,
- ptext SLIT("Probable cause: out-of-date interface files")]
+ , let things = case lookupUFM hpt mod of
+ Just info -> extract info
+ Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
+ msg = vcat [ptext (sLit "missing module") <+> ppr mod,
+ ptext (sLit "Probable cause: out-of-date interface files")]
-- This really shouldn't happen, but see Trac #962
-- And get its dfuns
- , rule <- rules ]
+ , thing <- things ]
+
\end{code}
%************************************************************************
-- | The result of searching for an imported module.
data FindResult
= Found ModLocation Module
- -- the module was found
+ -- ^ The module was found
| NoPackage PackageId
- -- the requested package was not found
+ -- ^ The requested package was not found
| FoundMultiple [PackageId]
- -- *error*: both in multiple packages
+ -- ^ _Error_: both in multiple packages
| PackageHidden PackageId
- -- for an explicit source import: the package containing the module is
+ -- ^ For an explicit source import, the package containing the module is
-- not exposed.
| ModuleHidden PackageId
- -- for an explicit source import: the package containing the module is
+ -- ^ For an explicit source import, the package containing the module is
-- exposed, but the module itself is hidden.
| NotFound [FilePath] (Maybe PackageId)
- -- the module was not found, the specified places were searched
+ -- ^ The module was not found, the specified places were searched
| NotFoundInPackage PackageId
- -- the module was not found in this package
+ -- ^ The module was not found in this package
-- | Cache that remembers where we found a particular module. Contains both
-- home modules and package modules. On @:load@, only home modules are
%* *
%************************************************************************
-A @ModIface@ plus a @ModDetails@ summarises everything we know
-about a compiled module. The @ModIface@ is the stuff *before* linking,
-and can be written out to an interface file. (The @ModDetails@ is after
-linking; it is the "linked" form of the mi_decls field.)
-
-When we *read* an interface file, we also construct a @ModIface@ from it,
-except that the mi_decls part is empty; when reading we consolidate
-the declarations into a single indexed map in the @PersistentRenamerState@.
-
\begin{code}
+-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
+-- about a compiled module. The 'ModIface' is the stuff *before* linking,
+-- and can be written out to an interface file. The 'ModDetails is after
+-- linking and can be completely recovered from just the 'ModIface'.
+--
+-- When we read an interface file, we also construct a 'ModIface' from it,
+-- except that we explicitly make the 'mi_decls' and a few other fields empty;
+-- as when reading we consolidate the declarations etc. into a number of indexed
+-- maps and environments in the 'ExternalPackageState'.
data ModIface
= ModIface {
- mi_module :: !Module,
- mi_mod_vers :: !Version, -- Module version: changes when anything changes
+ mi_module :: !Module, -- ^ Name of the module we are for
+ mi_iface_hash :: !Fingerprint, -- ^ Hash of the whole interface
+ mi_mod_hash :: !Fingerprint, -- ^ Hash of the ABI only
- mi_orphan :: !WhetherHasOrphans, -- Whether this module has orphans
- mi_finsts :: !WhetherHasFamInst, -- Whether module has family insts
- mi_boot :: !IsBootInterface, -- Read from an hi-boot file?
+ mi_orphan :: !WhetherHasOrphans, -- ^ Whether this module has orphans
+ mi_finsts :: !WhetherHasFamInst, -- ^ Whether this module has family instances
+ mi_boot :: !IsBootInterface, -- ^ Read from an hi-boot file?
mi_deps :: Dependencies,
+ -- ^ The dependencies of the module, consulted for directly
+ -- imported modules only
+
-- This is consulted for directly-imported modules,
-- but not for anything else (hence lazy)
-
- -- Usages; kept sorted so that it's easy to decide
- -- whether to write a new iface file (changing usages
- -- doesn't affect the version of this module)
mi_usages :: [Usage],
+ -- ^ Usages; kept sorted so that it's easy to decide
+ -- whether to write a new iface file (changing usages
+ -- doesn't affect the hash of this module)
+
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
-- Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
mi_exports :: ![IfaceExport],
- mi_exp_vers :: !Version, -- Version number of export list
+ -- ^ Records the modules that are the declaration points for things
+ -- exported by this module, and the 'OccName's of those things
+
+ mi_exp_hash :: !Fingerprint, -- ^ Hash of export list
- -- Fixities
mi_fixities :: [(OccName,Fixity)],
+ -- ^ Fixities
+
-- NOT STRICT! we read this field lazily from the interface file
- -- Deprecations
- mi_deprecs :: IfaceDeprecs,
+ mi_warns :: Warnings,
+ -- ^ Warnings
+
-- NOT STRICT! we read this field lazily from the interface file
-- Type, class and variable declarations
- -- The version of an Id changes if its fixity or deprecations change
+ -- The hash of an Id changes if its fixity or deprecations change
-- (as well as its type of course)
-- Ditto data constructors, class operations, except that
- -- the version of the parent class/tycon changes
- mi_decls :: [(Version,IfaceDecl)], -- Sorted
+ -- the hash of the parent class/tycon changes
+ mi_decls :: [(Fingerprint,IfaceDecl)], -- ^ Sorted type, variable, class etc. declarations
mi_globals :: !(Maybe GlobalRdrEnv),
- -- Binds all the things defined at the top level in
- -- the *original source* code for this module. which
+ -- ^ Binds all the things defined at the top level in
+ -- the /original source/ code for this module. which
-- is NOT the same as mi_exports, nor mi_decls (which
-- may contains declarations for things not actually
-- defined by the user). Used for GHCi and for inspecting
--
-- (We need the source file to figure out the
-- top-level environment, if we didn't compile this module
- -- from source then this field contains Nothing).
+ -- from source then this field contains @Nothing@).
--
-- Strictly speaking this field should live in the
- -- HomeModInfo, but that leads to more plumbing.
+ -- 'HomeModInfo', but that leads to more plumbing.
-- Instance declarations and rules
- mi_insts :: [IfaceInst], -- Sorted
- mi_fam_insts :: [IfaceFamInst], -- Sorted
- mi_rules :: [IfaceRule], -- Sorted
- mi_rule_vers :: !Version, -- Version number for rules and
- -- instances (for classes and families)
+ mi_insts :: [IfaceInst], -- ^ Sorted class instance
+ mi_fam_insts :: [IfaceFamInst], -- ^ Sorted family instances
+ mi_rules :: [IfaceRule], -- ^ Sorted rules
+ mi_orphan_hash :: !Fingerprint, -- ^ Hash for orphan rules and
+ -- class and family instances
-- combined
+ mi_vect_info :: !IfaceVectInfo, -- ^ Vectorisation information
+
-- Cached environments for easy lookup
-- These are computed (lazily) from other fields
-- and are not put into the interface file
- mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs
- mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities
- mi_ver_fn :: OccName -> Maybe (OccName, Version)
- -- Cached lookup for mi_decls
- -- The Nothing in mi_ver_fn means that the thing
+ mi_warn_fn :: Name -> Maybe WarningTxt, -- ^ Cached lookup for 'mi_warns'
+ mi_fix_fn :: OccName -> Fixity, -- ^ Cached lookup for 'mi_fixities'
+ mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
+ -- ^ Cached lookup for 'mi_decls'.
+ -- The @Nothing@ in 'mi_hash_fn' means that the thing
-- isn't in decls. It's useful to know that when
- -- seeing if we are up to date wrt the old interface
+ -- seeing if we are up to date wrt. the old interface.
-- The 'OccName' is the parent of the name, if it has one.
+ mi_hpc :: !AnyHpcUsage
+ -- ^ True if this program uses Hpc at any point in the program.
}
--- Should be able to construct ModDetails from mi_decls in ModIface
+-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
+-- for home modules only. Information relating to packages will be loaded into
+-- global environments in 'ExternalPackageState'.
data ModDetails
= ModDetails {
-- The next two fields are created by the typechecker
md_exports :: [AvailInfo],
- md_types :: !TypeEnv,
- md_insts :: ![Instance], -- Dfun-ids for the instances in this module
+ md_types :: !TypeEnv, -- ^ Local type environment for this particular module
+ md_insts :: ![Instance], -- ^ 'DFunId's for the instances in this module
md_fam_insts :: ![FamInst],
- md_rules :: ![CoreRule], -- Domain may include Ids from other modules
- md_dbg_sites :: ![(SiteNumber, Coord)] -- Breakpoint sites inserted by the renamer
+ md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules
+ md_vect_info :: !VectInfo -- ^ Module vectorisation information
}
+emptyModDetails :: ModDetails
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = [],
md_insts = [],
md_rules = [],
md_fam_insts = [],
- md_dbg_sites = noDbgSites}
+ md_vect_info = noVectInfo
+ }
--- A ModGuts is carried through the compiler, accumulating stuff as it goes
--- There is only one ModGuts at any time, the one for the module
--- being compiled right now. Once it is compiled, a ModIface and
--- ModDetails are extracted and the ModGuts is dicarded.
+-- | Records the modules directly imported by a module for extracting e.g. usage information
+type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
+-- TODO: we are not actually using the codomain of this type at all, so it can be
+-- replaced with ModuleEnv ()
+-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
+-- There is only one ModGuts at any time, the one for the module
+-- being compiled right now. Once it is compiled, a 'ModIface' and
+-- 'ModDetails' are extracted and the ModGuts is dicarded.
data ModGuts
= ModGuts {
- mg_module :: !Module,
- mg_boot :: IsBootInterface, -- Whether it's an hs-boot module
- mg_exports :: ![AvailInfo], -- What it exports
- mg_deps :: !Dependencies, -- What is below it, directly or
- -- otherwise
- mg_dir_imps :: ![Module], -- Directly-imported modules; used to
- -- generate initialisation code
- mg_usages :: ![Usage], -- Version info for what it needed
-
- mg_rdr_env :: !GlobalRdrEnv, -- Top-level lexical environment
- mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in
- -- this module
-
- mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment
- -- for *home-package* modules (including
- -- this one). c.f. tcg_fam_inst_env
-
- mg_types :: !TypeEnv,
- mg_insts :: ![Instance], -- Instances
- mg_fam_insts :: ![FamInst], -- Instances
- mg_rules :: ![CoreRule], -- Rules from this module
- mg_binds :: ![CoreBind], -- Bindings for this module
- mg_foreign :: !ForeignStubs,
- mg_deprecs :: !Deprecations, -- Deprecations declared in the module
- mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
- mg_dbg_sites :: ![(SiteNumber, Coord)] -- Bkpts inserted by the renamer
+ mg_module :: !Module, -- ^ Module being compiled
+ mg_boot :: IsBootInterface, -- ^ Whether it's an hs-boot module
+ mg_exports :: ![AvailInfo], -- ^ What it exports
+ mg_deps :: !Dependencies, -- ^ What it depends on, directly or
+ -- otherwise
+ mg_dir_imps :: !ImportedMods, -- ^ Directly-imported modules; used to
+ -- generate initialisation code
+ mg_used_names:: !NameSet, -- ^ What the module needed (used in 'MkIface.mkIface')
+
+ mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment
+
+ -- These fields all describe the things **declared in this module**
+ mg_fix_env :: !FixityEnv, -- ^ Fixities declared in this module
+ -- TODO: I'm unconvinced this is actually used anywhere
+ mg_types :: !TypeEnv, -- ^ Types declared in this module
+ mg_insts :: ![Instance], -- ^ Class instances declared in this module
+ mg_fam_insts :: ![FamInst], -- ^ Family instances declared in this module
+ mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
+ -- rules declared in this module. After the core
+ -- pipeline starts, it is changed to contain all
+ -- known rules for those things imported
+ mg_binds :: ![CoreBind], -- ^ Bindings for this module
+ mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module
+ mg_warns :: !Warnings, -- ^ Warnings declared in the module
+ mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
+ mg_modBreaks :: !ModBreaks, -- ^ Breakpoints for the module
+ mg_vect_info :: !VectInfo, -- ^ Pool of vectorised declarations in the module
+
+ -- The next two fields are unusual, because they give instance
+ -- environments for *all* modules in the home package, including
+ -- this module, rather than for *just* this module.
+ -- Reason: when looking up an instance we don't want to have to
+ -- look at each module in the home package in turn
+ mg_inst_env :: InstEnv,
+ -- ^ Class instance environment from /home-package/ modules (including
+ -- this one); c.f. 'tcg_inst_env'
+ mg_fam_inst_env :: FamInstEnv
+ -- ^ Type-family instance enviroment for /home-package/ modules
+ -- (including this one); c.f. 'tcg_fam_inst_env'
+ }
+
+-- The ModGuts takes on several slightly different forms:
+--
+-- After simplification, the following fields change slightly:
+-- mg_rules Orphan rules only (local ones now attached to binds)
+-- mg_binds With rules attached
+
+-- | A CoreModule consists of just the fields of a 'ModGuts' that are needed for
+-- the 'GHC.compileToCoreModule' interface.
+data CoreModule
+ = CoreModule {
+ -- | Module name
+ cm_module :: !Module,
+ -- | Type environment for types declared in this module
+ cm_types :: !TypeEnv,
+ -- | Declarations
+ cm_binds :: [CoreBind],
+ -- | Imports
+ cm_imports :: ![Module]
}
+instance Outputable CoreModule where
+ ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
+ text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
+
-- The ModGuts takes on several slightly different forms:
--
-- After simplification, the following fields change slightly:
-- * one lot goes to interface file generation (ModIface)
-- and later compilations (ModDetails)
-- * the other lot goes to code generation (CgGuts)
+
+-- | A restricted form of 'ModGuts' for code generation purposes
data CgGuts
= CgGuts {
- cg_module :: !Module,
+ cg_module :: !Module, -- ^ Module being compiled
cg_tycons :: [TyCon],
- -- Algebraic data types (including ones that started
+ -- ^ Algebraic data types (including ones that started
-- life as classes); generate constructors and info
- -- tables Includes newtypes, just for the benefit of
+ -- tables. Includes newtypes, just for the benefit of
-- External Core
cg_binds :: [CoreBind],
- -- The tidied main bindings, including
+ -- ^ The tidied main bindings, including
-- previously-implicit bindings for record and class
-- selectors, and data construtor wrappers. But *not*
-- data constructor workers; reason: we we regard them
-- as part of the code-gen of tycons
cg_dir_imps :: ![Module],
- -- Directly-imported modules; used to generate
+ -- ^ Directly-imported modules; used to generate
-- initialisation code
- cg_foreign :: !ForeignStubs,
- cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen
- cg_hpc_info :: !HpcInfo -- info about coverage tick boxes
+ cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
+ cg_dep_pkgs :: ![PackageId], -- ^ Dependent packages, used to
+ -- generate #includes for C code gen
+ cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
+ cg_modBreaks :: !ModBreaks -- ^ Module breakpoints
}
-----------------------------------
-data ModImports
- = ModImports {
- imp_direct :: ![(Module,Bool)], -- Explicitly-imported modules
- -- Boolean is true if we imported the whole
- -- module (apart, perhaps, from hiding some)
- imp_pkg_mods :: !ModuleSet, -- Non-home-package modules on which we depend,
- -- directly or indirectly
- imp_home_names :: !NameSet -- Home package things on which we depend,
- -- directly or indirectly
- }
-
------------------------------------
-data ForeignStubs = NoStubs
+-- | Foreign export stubs
+data ForeignStubs = NoStubs -- ^ We don't have any stubs
| ForeignStubs
- SDoc -- Header file prototypes for
- -- "foreign exported" functions
- SDoc -- C stubs to use when calling
- -- "foreign exported" functions
- [FastString] -- Headers that need to be included
- -- into C code generated for this module
- [Id] -- Foreign-exported binders
- -- we have to generate code to register these
-
+ SDoc
+ SDoc
+ -- ^ There are some stubs. Parameters:
+ --
+ -- 1) Header file prototypes for
+ -- "foreign exported" functions
+ --
+ -- 2) C stubs to use when calling
+ -- "foreign exported" functions
\end{code}
\begin{code}
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
- mi_mod_vers = initialVersion,
+ mi_iface_hash = fingerprint0,
+ mi_mod_hash = fingerprint0,
mi_orphan = False,
mi_finsts = False,
mi_boot = False,
mi_deps = noDependencies,
mi_usages = [],
mi_exports = [],
- mi_exp_vers = initialVersion,
+ mi_exp_hash = fingerprint0,
mi_fixities = [],
- mi_deprecs = NoDeprecs,
+ mi_warns = NoWarnings,
mi_insts = [],
mi_fam_insts = [],
mi_rules = [],
mi_decls = [],
mi_globals = Nothing,
- mi_rule_vers = initialVersion,
- mi_dep_fn = emptyIfaceDepCache,
- mi_fix_fn = emptyIfaceFixCache,
- mi_ver_fn = emptyIfaceVerCache
+ mi_orphan_hash = fingerprint0,
+ mi_vect_info = noIfaceVectInfo,
+ mi_warn_fn = emptyIfaceWarnCache,
+ mi_fix_fn = emptyIfaceFixCache,
+ mi_hash_fn = emptyIfaceHashCache,
+ mi_hpc = False
}
\end{code}
%************************************************************************
\begin{code}
+-- | Interactive context, recording information relevant to GHCi
data InteractiveContext
= InteractiveContext {
- ic_toplev_scope :: [Module], -- Include the "top-level" scope of
+ ic_toplev_scope :: [Module], -- ^ The context includes the "top-level" scope of
-- these modules
- ic_exports :: [Module], -- Include just the exports of these
+ ic_exports :: [Module], -- ^ The context includes just the exports of these
-- modules
- ic_rn_gbl_env :: GlobalRdrEnv, -- The cached GlobalRdrEnv, built from
- -- ic_toplev_scope and ic_exports
+ ic_rn_gbl_env :: GlobalRdrEnv, -- ^ The contexts' cached 'GlobalRdrEnv', built from
+ -- 'ic_toplev_scope' and 'ic_exports'
+
+ ic_tmp_ids :: [Id], -- ^ Names bound during interaction with the user.
+ -- Later Ids shadow earlier ones with the same OccName.
- ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound
- -- during interaction
+ ic_tyvars :: TyVarSet -- ^ Skolem type variables free in
+ -- 'ic_tmp_ids'. These arise at
+ -- breakpoints in a polymorphic
+ -- context, where we have only partial
+ -- type information.
- ic_type_env :: TypeEnv -- Ditto for types
+#ifdef GHCI
+ , ic_resume :: [Resume] -- ^ The stack of breakpoint contexts
+#endif
}
+
+emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
- ic_rn_local_env = emptyLocalRdrEnv,
- ic_type_env = emptyTypeEnv }
-
-icPrintUnqual :: InteractiveContext -> PrintUnqualified
-icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+ ic_tmp_ids = [],
+ ic_tyvars = emptyVarSet
+#ifdef GHCI
+ , ic_resume = []
+#endif
+ }
+
+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
+icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
+
+
+extendInteractiveContext
+ :: InteractiveContext
+ -> [Id]
+ -> TyVarSet
+ -> InteractiveContext
+extendInteractiveContext ictxt ids tyvars
+ = ictxt { ic_tmp_ids = snub((ic_tmp_ids ictxt \\ ids) ++ ids),
+ -- NB. must be this way around, because we want
+ -- new ids to shadow existing bindings.
+ ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars }
+ where snub = map head . group . sort
+
+substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
+substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst =
+ let ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids
+ subst_dom= varEnvKeys$ getTvSubstEnv subst
+ subst_ran= varEnvElts$ getTvSubstEnv subst
+ new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran]
+ ic_tyvars'= (`delVarSetListByKey` subst_dom)
+ . (`extendVarSetList` new_tvs)
+ $ ic_tyvars ictxt
+ in ictxt { ic_tmp_ids = ids'
+ , ic_tyvars = ic_tyvars' }
+
+ where delVarSetListByKey = foldl' delVarSetByKey
\end{code}
%************************************************************************
%* *
%************************************************************************
+Deciding how to print names is pretty tricky. We are given a name
+P:M.T, where P is the package name, M is the defining module, and T is
+the occurrence name, and we have to decide in which form to display
+the name given a GlobalRdrEnv describing the current scope.
+
+Ideally we want to display the name in the form in which it is in
+scope. However, the name might not be in scope at all, and that's
+where it gets tricky. Here are the cases:
+
+ 1. T uniquely maps to P:M.T ---> "T"
+ 2. there is an X for which X.T uniquely maps to P:M.T ---> "X.T"
+ 3. there is no binding for "M.T" ---> "M.T"
+ 4. otherwise ---> "P:M.T"
+
+3 and 4 apply when P:M.T is not in scope. In these cases we want to
+refer to the name as "M.T", but "M.T" might mean something else in the
+current scope (e.g. if there's an "import X as M"), so to avoid
+confusion we avoid using "M.T" if there's already a binding for it.
+
+There's one further subtlety: if the module M cannot be imported
+because it is not exposed by any package, then we must refer to it as
+"P:M". This is handled by the qual_mod component of PrintUnqualified.
+
\begin{code}
-mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualified env = (qual_name, qual_mod)
+-- | Creates some functions that work out the best ways to format
+-- names for the user according to a set of heuristics
+mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualified dflags env = (qual_name, qual_mod)
where
- qual_name mod occ
- | null gres = Just (moduleName mod)
- -- it isn't in scope at all, this probably shouldn't happen,
- -- but we'll qualify it by the original module anyway.
- | any unQualOK gres = Nothing
- | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is
- = Just (is_as (is_decl idecl))
- | otherwise = panic "mkPrintUnqualified"
+ qual_name mod occ -- The (mod,occ) pair is the original name of the thing
+ | [gre] <- unqual_gres, right_name gre = NameUnqual
+ -- If there's a unique entity that's in scope unqualified with 'occ'
+ -- AND that entity is the right one, then we can use the unqualified name
+
+ | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
+
+ | null qual_gres =
+ if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
+ then NameNotInScope1
+ else NameNotInScope2
+
+ | otherwise = panic "mkPrintUnqualified"
where
- gres = [ gre | gre <- lookupGlobalRdrEnv env occ,
- nameModule (gre_name gre) == mod ]
+ right_name gre = nameModule_maybe (gre_name gre) == Just mod
+
+ unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
+ qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
- qual_mod mod = Nothing -- For now...
+ get_qual_mod LocalDef = moduleName mod
+ get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
+
+ -- we can mention a module P:M without the P: qualifier iff
+ -- "import M" would resolve unambiguously to P:M. (if P is the
+ -- current package we can just assume it is unqualified).
+
+ qual_mod mod
+ | modulePackageId mod == thisPackage dflags = False
+
+ | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup,
+ exposed pkg && exposed_module],
+ packageConfigId pkgconfig == modulePackageId mod
+ -- this says: we are given a module P:M, is there just one exposed package
+ -- that exposes a module M, and is it package P?
+ = False
+
+ | otherwise = True
+ where lookup = lookupModuleInAllPackages dflags (moduleName mod)
\end{code}
%************************************************************************
\begin{code}
+-- | Determine the 'TyThing's brought into scope by another 'TyThing'
+-- /other/ than itself. For example, Id's don't have any implicit TyThings
+-- as they just bring themselves into scope, but classes bring their
+-- dictionary datatype, type constructor and some selector functions into
+-- scope, just for a start!
+
+-- N.B. the set of TyThings returned here *must* match the set of
+-- names returned by LoadIface.ifaceDeclSubBndrs, in the sense that
+-- TyThing.getOccName should define a bijection between the two lists.
+-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
+-- The order of the list does not matter.
implicitTyThings :: TyThing -> [TyThing]
--- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
-
-implicitTyThings (AnId id) = []
-
- -- For type constructors, add the data cons (and their extras),
- -- and the selectors and generic-programming Ids too
- --
- -- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
- map AnId (tyConSelIds tc) ++
- concatMap (extras_plus . ADataCon)
- (tyConDataCons tc)
+
+-- For data and newtype declarations:
+implicitTyThings (ATyCon tc) =
+ -- fields (names of selectors)
+ map AnId (tyConSelIds tc) ++
+ -- (possibly) implicit coercion and family coercion
+ -- depending on whether it's a newtype or a family instance or both
+ implicitCoTyCon tc ++
+ -- for each data constructor in order,
+ -- the contructor, worker, and (possibly) wrapper
+ concatMap (extras_plus . ADataCon) (tyConDataCons tc)
- -- For classes, add the class selector Ids, and assoicated TyCons
- -- and the class TyCon too (and its extras)
implicitTyThings (AClass cl)
- = map AnId (classSelIds cl) ++
+ = -- dictionary datatype:
+ -- [extras_plus:]
+ -- type constructor
+ -- [recursive call:]
+ -- (possibly) newtype coercion; definitely no family coercion here
+ -- data constructor
+ -- worker
+ -- (no wrapper by invariant)
+ extras_plus (ATyCon (classTyCon cl)) ++
+ -- associated types
+ -- No extras_plus (recursive call) for the classATs, because they
+ -- are only the family decls; they have no implicit things
map ATyCon (classATs cl) ++
- -- No extras_plus for the classATs, because they
- -- are only the family decls; they have no implicit things
- extras_plus (ATyCon (classTyCon cl))
+ -- superclass and operation selectors
+ map AnId (classSelIds cl)
+
+implicitTyThings (ADataCon dc) =
+ -- For data cons add the worker and (possibly) wrapper
+ map AnId (dataConImplicitIds dc)
- -- For data cons add the worker and wrapper (if any)
-implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
+implicitTyThings (AnId _) = []
--- | returns 'True' if there should be no interface-file declaration
+-- add a thing and recursive call
+extras_plus :: TyThing -> [TyThing]
+extras_plus thing = thing : implicitTyThings thing
+
+-- For newtypes and indexed data types (and both),
+-- add the implicit coercion tycon
+implicitCoTyCon :: TyCon -> [TyThing]
+implicitCoTyCon tc
+ = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
+ newTyConCo_maybe tc,
+ -- Just if family instance, Nothing if not
+ tyConFamilyCoercion_maybe tc]
+
+-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
+
+
+-- | Returns @True@ if there should be no interface-file declaration
-- for this thing on its own: either it is built-in, or it is part
-- of some other declaration, or it is generated implicitly by some
-- other declaration.
isImplicitTyThing (AClass _) = False
isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
- -- For newtypes and indexed data types, add the implicit coercion tycon
-implicitCoTyCon tc
- = map ATyCon . catMaybes $ [newTyConCo_maybe tc,
- tyConFamilyCoercion_maybe tc]
-
-extras_plus thing = thing : implicitTyThings thing
-
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
= extendNameEnvList env [(getName id, AnId id) | id <- ids]
%************************************************************************
\begin{code}
+-- | A map from 'Name's to 'TyThing's, constructed by typechecking
+-- local declarations or interface files
type TypeEnv = NameEnv TyThing
emptyTypeEnv :: TypeEnv
\end{code}
\begin{code}
+-- | Find the 'TyThing' for the given 'Name' by using all the resources
+-- at our disposal: the compiled modules in the 'HomePackageTable' and the
+-- compiled modules in other packages that live in 'PackageTypeEnv'. Note
+-- that this does NOT look up the 'TyThing' in the module being compiled: you
+-- have to do that yourself, if desired
lookupType :: DynFlags
-> HomePackageTable
-> PackageTypeEnv
lookupNameEnv (md_types (hm_details hm)) name
| otherwise
= lookupNameEnv pte name
- where mod = nameModule name
+ where mod = ASSERT( isExternalName name ) nameModule name
this_pkg = thisPackage dflags
+
+-- | As 'lookupType', but with a marginally easier-to-use interface
+-- if you have a 'HscEnv'
+lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
+lookupTypeHscEnv hsc_env name = do
+ eps <- readIORef (hsc_EPS hsc_env)
+ return $ lookupType dflags hpt (eps_PTE eps) name
+ where
+ dflags = hsc_dflags hsc_env
+ hpt = hsc_HPT hsc_env
\end{code}
\begin{code}
+-- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
+tyThingTyCon :: TyThing -> TyCon
tyThingTyCon (ATyCon tc) = tc
-tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
+tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
+-- | Get the 'Class' from a 'TyThing' if it is a class thing. Panics otherwise
+tyThingClass :: TyThing -> Class
tyThingClass (AClass cls) = cls
-tyThingClass other = pprPanic "tyThingClass" (ppr other)
+tyThingClass other = pprPanic "tyThingClass" (pprTyThing other)
+-- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
+tyThingDataCon :: TyThing -> DataCon
tyThingDataCon (ADataCon dc) = dc
-tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other)
+tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
-tyThingId (AnId id) = id
-tyThingId other = pprPanic "tyThingId" (ppr other)
+-- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
+tyThingId :: TyThing -> Id
+tyThingId (AnId id) = id
+tyThingId (ADataCon dc) = dataConWrapId dc
+tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
%************************************************************************
-%* *
-\subsection{Auxiliary types}
-%* *
+%* *
+\subsection{MonadThings and friends}
+%* *
%************************************************************************
-These types are defined here because they are mentioned in ModDetails,
-but they are mostly elaborated elsewhere
+\begin{code}
+-- | Class that abstracts out the common ability of the monads in GHC
+-- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides
+-- a number of related convenience functions for accessing particular
+-- kinds of 'TyThing'
+class Monad m => MonadThings m where
+ lookupThing :: Name -> m TyThing
+
+ lookupId :: Name -> m Id
+ lookupId = liftM tyThingId . lookupThing
+
+ lookupDataCon :: Name -> m DataCon
+ lookupDataCon = liftM tyThingDataCon . lookupThing
+
+ lookupTyCon :: Name -> m TyCon
+ lookupTyCon = liftM tyThingTyCon . lookupThing
+
+ lookupClass :: Name -> m Class
+ lookupClass = liftM tyThingClass . lookupThing
+\end{code}
\begin{code}
-mkIfaceVerCache :: [(Version,IfaceDecl)]
- -> (OccName -> Maybe (OccName, Version))
-mkIfaceVerCache pairs
+-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
+mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
+ -> (OccName -> Maybe (OccName, Fingerprint))
+mkIfaceHashCache pairs
= \occ -> lookupOccEnv env occ
where
env = foldr add_decl emptyOccEnv pairs
env1 = extendOccEnv env0 decl_name (decl_name, v)
add_imp bndr env = extendOccEnv env bndr (decl_name, v)
-emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
-emptyIfaceVerCache occ = Nothing
+emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
+emptyIfaceHashCache _occ = Nothing
+\end{code}
------------------- Deprecations -------------------------
-data Deprecs a
- = NoDeprecs
- | DeprecAll DeprecTxt -- Whole module deprecated
- | DeprecSome a -- Some specific things deprecated
- deriving( Eq )
+%************************************************************************
+%* *
+\subsection{Auxiliary types}
+%* *
+%************************************************************************
-type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
-type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
- -- Keep the OccName so we can flatten the NameEnv to
- -- get an IfaceDeprecs from a Deprecations
- -- Only an OccName is needed, because a deprecation always
- -- applies to things defined in the module in which the
- -- deprecation appears.
-
-mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
-mkIfaceDepCache NoDeprecs = \n -> Nothing
-mkIfaceDepCache (DeprecAll t) = \n -> Just t
-mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
-
-emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache n = Nothing
-
-plusDeprecs :: Deprecations -> Deprecations -> Deprecations
-plusDeprecs d NoDeprecs = d
-plusDeprecs NoDeprecs d = d
-plusDeprecs d (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) d = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
-\end{code}
+These types are defined here because they are mentioned in ModDetails,
+but they are mostly elaborated elsewhere
+\begin{code}
+------------------ Warnings -------------------------
+-- | Warning information for a module
+data Warnings
+ = NoWarnings -- ^ Nothing deprecated
+ | WarnAll WarningTxt -- ^ Whole module deprecated
+ | WarnSome [(OccName,WarningTxt)] -- ^ Some specific things deprecated
+
+ -- Only an OccName is needed because
+ -- (1) a deprecation always applies to a binding
+ -- defined in the module in which the deprecation appears.
+ -- (2) deprecations are only reported outside the defining module.
+ -- this is important because, otherwise, if we saw something like
+ --
+ -- {-# DEPRECATED f "" #-}
+ -- f = ...
+ -- h = f
+ -- g = let f = undefined in f
+ --
+ -- we'd need more information than an OccName to know to say something
+ -- about the use of f in h but not the use of the locally bound f in g
+ --
+ -- however, because we only report about deprecations from the outside,
+ -- and a module can only export one value called f,
+ -- an OccName suffices.
+ --
+ -- this is in contrast with fixity declarations, where we need to map
+ -- a Name to its fixity declaration.
+ deriving( Eq )
+-- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'
+mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt
+mkIfaceWarnCache NoWarnings = \_ -> Nothing
+mkIfaceWarnCache (WarnAll t) = \_ -> Just t
+mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
+
+emptyIfaceWarnCache :: Name -> Maybe WarningTxt
+emptyIfaceWarnCache _ = Nothing
+
+plusWarns :: Warnings -> Warnings -> Warnings
+plusWarns d NoWarnings = d
+plusWarns NoWarnings d = d
+plusWarns _ (WarnAll t) = WarnAll t
+plusWarns (WarnAll t) _ = WarnAll t
+plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
+\end{code}
\begin{code}
+-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]
+-- | 'Name'd things that are available
type AvailInfo = GenAvailInfo Name
+-- | 'RdrName'd things that are available
type RdrAvailInfo = GenAvailInfo OccName
-data GenAvailInfo name = Avail name -- An ordinary identifier
- | AvailTC name -- The name of the type or class
- [name] -- The available pieces of type/class.
- -- NB: If the type or class is itself
- -- to be in scope, it must be in this list.
- -- Thus, typically: AvailTC Eq [Eq, ==, /=]
+-- | Records what things are "available", i.e. in scope
+data GenAvailInfo name = Avail name -- ^ An ordinary identifier in scope
+ | AvailTC name
+ [name] -- ^ A type or class in scope. Parameters:
+ --
+ -- 1) The name of the type or class
+ --
+ -- 2) The available pieces of type or class.
+ -- NB: If the type or class is itself
+ -- to be in scope, it must be in this list.
+ -- Thus, typically: @AvailTC Eq [Eq, ==, \/=]@
deriving( Eq )
-- Equality used when deciding if the interface has changed
+-- | The original names declared of a certain module that are exported
type IfaceExport = (Module, [GenAvailInfo OccName])
availsToNameSet :: [AvailInfo] -> NameSet
where add avail env = extendNameEnvList env
(zip (availNames avail) (repeat avail))
+-- | Just the main name made available, i.e. not the available pieces
+-- of type or class brought into scope by the 'GenAvailInfo'
availName :: GenAvailInfo name -> name
availName (Avail n) = n
availName (AvailTC n _) = n
+-- | All names made available by the availability information
availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
-availNames (AvailTC n ns) = ns
+availNames (AvailTC _ ns) = ns
instance Outputable n => Outputable (GenAvailInfo n) where
ppr = pprAvail
\end{code}
\begin{code}
+-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
mkIfaceFixCache pairs
= \n -> lookupOccEnv env n `orElse` defaultFixity
env = mkOccEnv pairs
emptyIfaceFixCache :: OccName -> Fixity
-emptyIfaceFixCache n = defaultFixity
+emptyIfaceFixCache _ = defaultFixity
--- This fixity environment is for source code only
+-- | Fixity environment mapping names to their fixities
type FixityEnv = NameEnv FixItem
--- We keep the OccName in the range so that we can generate an interface from it
-data FixItem = FixItem OccName Fixity SrcSpan
+-- | Fixity information for an 'Name'. We keep the OccName in the range
+-- so that we can generate an interface from it
+data FixItem = FixItem OccName Fixity
instance Outputable FixItem where
- ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
+ ppr (FixItem occ fix) = ppr fix <+> ppr occ
emptyFixityEnv :: FixityEnv
emptyFixityEnv = emptyNameEnv
lookupFixity :: FixityEnv -> Name -> Fixity
lookupFixity env n = case lookupNameEnv env n of
- Just (FixItem _ fix _) -> fix
- Nothing -> defaultFixity
+ Just (FixItem _ fix) -> fix
+ Nothing -> defaultFixity
\end{code}
%************************************************************************
\begin{code}
+-- | Records whether a module has orphans. An \"orphan\" is one of:
+--
+-- * An instance declaration in a module other than the definition
+-- module for one of the type constructors or classes in the instance head
+--
+-- * A transformation rule in a module other than the one defining
+-- the function in the head of the rule
type WhetherHasOrphans = Bool
- -- An "orphan" is
- -- * an instance decl in a module other than the defn module for
- -- one of the tycons or classes in the instance head
- -- * a transformation rule in a module other than the one defining
- -- the function in the head of the rule.
-type WhetherHasFamInst = Bool -- This module defines family instances?
+-- | Does this module define family instances?
+type WhetherHasFamInst = Bool
+-- | Did this module originate from a *-boot file?
type IsBootInterface = Bool
--- Dependency info about modules and packages below this one
--- in the import hierarchy. See TcRnTypes.ImportAvails for details.
--- The orphan modules in `dep_orphs' do *not* include family instance orphans,
--- as they are anyway included in `dep_finsts'.
+-- | Dependency information about modules and packages below this one
+-- in the import hierarchy.
--
--- Invariant: the dependencies of a module M never includes M
--- Invariant: the lists are unordered, with no duplicates
+-- Invariant: the dependencies of a module @M@ never includes @M@.
+--
+-- Invariant: none of the lists contain duplicates.
data Dependencies
- = Deps { dep_mods :: [(ModuleName, -- Home-package module dependencies
- IsBootInterface)]
- , dep_pkgs :: [PackageId] -- External package dependencies
- , dep_orphs :: [Module] -- Orphan modules (whether home or
- -- external pkg)
- , dep_finsts :: [Module] -- Modules that contain family
- -- instances (whether home or
- -- external pkg)
+ = Deps { dep_mods :: [(ModuleName, IsBootInterface)]
+ -- ^ Home-package module dependencies
+ , dep_pkgs :: [PackageId]
+ -- ^ External package dependencies
+ , dep_orphs :: [Module]
+ -- ^ Orphan modules (whether home or external pkg),
+ -- *not* including family instance orphans as they
+ -- are anyway included in 'dep_finsts'
+ , dep_finsts :: [Module]
+ -- ^ Modules that contain family instances (whether the
+ -- instances are from the home or an external package)
}
deriving( Eq )
-- Equality used only for old/new comparison in MkIface.addVersionInfo
+ -- See 'TcRnTypes.ImportAvails' for details on dependencies.
+
noDependencies :: Dependencies
noDependencies = Deps [] [] [] []
-
-data Usage
- = Usage { usg_name :: ModuleName, -- Name of the module
- usg_mod :: Version, -- Module version
- usg_entities :: [(OccName,Version)], -- Sorted by occurrence name
- -- NB. usages are for parent names only, eg. tycon but not constructors.
- usg_exports :: Maybe Version, -- Export-list version, if we depend on it
- usg_rules :: Version -- Orphan-rules version (for non-orphan
- -- modules this will always be initialVersion)
- } deriving( Eq )
- -- This type doesn't let you say "I imported f but none of the rules in
- -- the module". If you use anything in the module you get its rule version
- -- So if the rules change, you'll recompile, even if you don't use them.
- -- This is easy to implement, and it's safer: you might not have used the rules last
- -- time round, but if someone has added a new rule you might need it this time
+-- | Records modules that we depend on by making a direct import from
+data Usage
+ = UsagePackageModule {
+ usg_mod :: Module,
+ -- ^ External package module depended on
+ usg_mod_hash :: Fingerprint
+ } -- ^ Module from another package
+ | UsageHomeModule {
+ usg_mod_name :: ModuleName,
+ -- ^ Name of the module
+ usg_mod_hash :: Fingerprint,
+ -- ^ Cached module fingerprint
+ usg_entities :: [(OccName,Fingerprint)],
+ -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.
+ -- NB: usages are for parent names only, e.g. type constructors
+ -- but not the associated data constructors.
+ usg_exports :: Maybe Fingerprint
+ -- ^ Fingerprint for the export list we used to depend on this module,
+ -- if we depend on the export list
+ } -- ^ Module from the current package
+ deriving( Eq )
-- The export list field is (Just v) if we depend on the export list:
-- i.e. we imported the module directly, whether or not we
- -- enumerated the things we imported, or just imported everything
+ -- enumerated the things we imported, or just imported
+ -- everything
-- We need to recompile if M's exports change, because
- -- if the import was import M, we might now have a name clash in the
- -- importing module.
+ -- if the import was import M, we might now have a name clash
+ -- in the importing module.
-- if the import was import M(x) M might no longer export x
-- The only way we don't depend on the export list is if we have
-- import M()
type PackageRuleBase = RuleBase
type PackageInstEnv = InstEnv
type PackageFamInstEnv = FamInstEnv
+type PackageVectInfo = VectInfo
+-- | Information about other packages that we have slurped in by reading
+-- their interface files
data ExternalPackageState
= EPS {
eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
- -- In OneShot mode (only), home-package modules
+ -- ^ In OneShot mode (only), home-package modules
-- accumulate in the external package state, and are
-- sucked in lazily. For these home-pkg modules
-- (only) we need to record which are boot modules.
-- explicitly-imported interfaces, but before doing
-- anything else
--
- -- The ModuleName part is not necessary, but it's useful for
+ -- The 'ModuleName' part is not necessary, but it's useful for
-- debug prints, and it's convenient because this field comes
- -- direct from TcRnTypes.ImportAvails.imp_dep_mods
+ -- direct from 'TcRnTypes.imp_dep_mods'
eps_PIT :: !PackageIfaceTable,
- -- The ModuleIFaces for modules in external packages
- -- whose interfaces we have opened
- -- The declarations in these interface files are held in
- -- eps_decls, eps_inst_env, eps_fam_inst_env, eps_rules
- -- (below), not in the mi_decls fields of the iPIT.
- -- What _is_ in the iPIT is:
- -- * The Module
- -- * Version info
- -- * Its exports
- -- * Fixities
- -- * Deprecations
-
- eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules
-
- eps_inst_env :: !PackageInstEnv, -- The total InstEnv accumulated
- -- from all the external-package
- -- modules
- eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
- eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv
-
- eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family
- -- instances of each mod
-
- eps_stats :: !EpsStats
+ -- ^ The 'ModIface's for modules in external packages
+ -- whose interfaces we have opened.
+ -- The declarations in these interface files are held in the
+ -- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'
+ -- fields of this record, not in the 'mi_decls' fields of the
+ -- interface we have sucked in.
+ --
+ -- What /is/ in the PIT is:
+ --
+ -- * The Module
+ --
+ -- * Fingerprint info
+ --
+ -- * Its exports
+ --
+ -- * Fixities
+ --
+ -- * Deprecations and warnings
+
+ eps_PTE :: !PackageTypeEnv,
+ -- ^ Result of typechecking all the external package
+ -- interface files we have sucked in. The domain of
+ -- the mapping is external-package modules
+
+ eps_inst_env :: !PackageInstEnv, -- ^ The total 'InstEnv' accumulated
+ -- from all the external-package modules
+ eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated
+ -- from all the external-package modules
+ eps_rule_base :: !PackageRuleBase, -- ^ The total 'RuleEnv' accumulated
+ -- from all the external-package modules
+ eps_vect_info :: !PackageVectInfo, -- ^ The total 'VectInfo' accumulated
+ -- from all the external-package modules
+
+ eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external
+ -- packages, keyed off the module that declared them
+
+ eps_stats :: !EpsStats -- ^ Stastics about what was loaded from external packages
}
--- "In" means read from iface files
--- "Out" means actually sucked in and type-checked
+-- | Accumulated statistics about what we are putting into the 'ExternalPackageState'.
+-- \"In\" means stuff that is just /read/ from interface files,
+-- \"Out\" means actually sucked in and type-checked
data EpsStats = EpsStats { n_ifaces_in
, n_decls_in, n_decls_out
, n_rules_in, n_rules_out
, n_insts_in, n_insts_out :: !Int }
addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
--- Add stats for one newly-read interface
+-- ^ Add stats for one newly-read interface
addEpsInStats stats n_decls n_insts n_rules
= stats { n_ifaces_in = n_ifaces_in stats + 1
, n_decls_in = n_decls_in stats + n_decls
, n_rules_in = n_rules_in stats + n_rules }
\end{code}
-The NameCache makes sure that there is just one Unique assigned for
-each original name; i.e. (module-name, occ-name) pair. The Name is
-always stored as a Global, and has the SrcLoc of its binding location.
+Names in a NameCache are always stored as a Global, and have the SrcLoc
+of their binding locations.
+
Actually that's not quite right. When we first encounter the original
name, we might not be at its binding site (e.g. we are reading an
interface file); so we give it 'noSrcLoc' then. Later, when we find
its binding site, we fix it up.
\begin{code}
+-- | The NameCache makes sure that there is just one Unique assigned for
+-- each original name; i.e. (module-name, occ-name) pair and provides
+-- something of a lookup mechanism for those names.
data NameCache
= NameCache { nsUniqs :: UniqSupply,
- -- Supply of uniques
+ -- ^ Supply of uniques
nsNames :: OrigNameCache,
- -- Ensures that one original name gets one unique
+ -- ^ Ensures that one original name gets one unique
nsIPs :: OrigIParamCache
- -- Ensures that one implicit parameter name gets one unique
+ -- ^ Ensures that one implicit parameter name gets one unique
}
+-- | Per-module cache of original 'OccName's given 'Name's
type OrigNameCache = ModuleEnv (OccEnv Name)
+
+-- | Module-local cache of implicit parameter 'OccName's given 'Name's
type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
\end{code}
%* *
%************************************************************************
-A ModuleGraph contains all the nodes from the home package (only).
-There will be a node for each source module, plus a node for each hi-boot
-module.
-
\begin{code}
-type ModuleGraph = [ModSummary] -- The module graph,
- -- NOT NECESSARILY IN TOPOLOGICAL ORDER
+-- | A ModuleGraph contains all the nodes from the home package (only).
+-- There will be a node for each source module, plus a node for each hi-boot
+-- module.
+--
+-- The graph is not necessarily stored in topologically-sorted order.
+type ModuleGraph = [ModSummary]
emptyMG :: ModuleGraph
emptyMG = []
--- The nodes of the module graph are
--- EITHER a regular Haskell source module
--- OR a hi-boot source module
-
+-- | A single node in a 'ModuleGraph. The nodes of the module graph are one of:
+--
+-- * A regular Haskell source module
+--
+-- * A hi-boot source module
+--
+-- * An external-core source module
data ModSummary
= ModSummary {
- ms_mod :: Module, -- Identity of the module
- ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core
- ms_location :: ModLocation, -- Location
- ms_hs_date :: ClockTime, -- Timestamp of source file
- ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe
- ms_srcimps :: [Located ModuleName], -- Source imports
- ms_imps :: [Located ModuleName], -- Non-source imports
- ms_hspp_file :: FilePath, -- Filename of preprocessed source.
- ms_hspp_opts :: DynFlags, -- Cached flags from OPTIONS, INCLUDE
- -- and LANGUAGE pragmas.
- ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe.
+ ms_mod :: Module, -- ^ Identity of the module
+ ms_hsc_src :: HscSource, -- ^ The module source either plain Haskell, hs-boot or external core
+ ms_location :: ModLocation, -- ^ Location of the various files belonging to the module
+ ms_hs_date :: ClockTime, -- ^ Timestamp of source file
+ ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one
+ ms_srcimps :: [Located ModuleName], -- ^ Source imports of the module
+ ms_imps :: [Located ModuleName], -- ^ Non-source imports of the module
+ ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file
+ ms_hspp_opts :: DynFlags, -- ^ Cached flags from @OPTIONS@, @INCLUDE@
+ -- and @LANGUAGE@ pragmas in the modules source code
+ ms_hspp_buf :: Maybe StringBuffer -- ^ The actual preprocessed source, if we have it
}
+ms_mod_name :: ModSummary -> ModuleName
+ms_mod_name = moduleName . ms_mod
+
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done. The point is that the summariser will have to cpp/unlit/whatever
msHiFilePath ms = ml_hi_file (ms_location ms)
msObjFilePath ms = ml_obj_file (ms_location ms)
+-- | Did this 'ModSummary' originate from a hs-boot file?
isBootSummary :: ModSummary -> Bool
isBootSummary ms = isHsBoot (ms_hsc_src ms)
showModMsg :: HscTarget -> Bool -> ModSummary -> String
showModMsg target recomp mod_summary
- = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
- char '(', text (msHsFilePath mod_summary) <> comma,
- case target of
-#if defined(GHCI) && defined(DEBUGGER)
- HscInterpreted | recomp &&
- Opt_Debugging `elem` modflags
- -> text "interpreted(debugging)"
-#endif
- HscInterpreted | recomp
- -> text "interpreted"
- HscNothing -> text "nothing"
- _other -> text (msObjFilePath mod_summary),
- char ')'])
+ = showSDoc $
+ hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+ char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
+ case target of
+ HscInterpreted | recomp
+ -> text "interpreted"
+ HscNothing -> text "nothing"
+ _ -> text (normalise $ msObjFilePath mod_summary),
+ char ')']
where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
- modflags= flags(ms_hspp_opts mod_summary)
\end{code}
%************************************************************************
\begin{code}
-type HpcInfo = Int -- just the number of ticks in a module
+-- | Information about a modules use of Haskell Program Coverage
+data HpcInfo
+ = HpcInfo
+ { hpcInfoTickCount :: Int
+ , hpcInfoHash :: Int
+ }
+ | NoHpcInfo
+ { hpcUsed :: AnyHpcUsage -- ^ Is hpc used anywhere on the module \*tree\*?
+ }
+
+-- | This is used to signal if one of my imports used HPC instrumentation
+-- even if there is no module-local HPC usage
+type AnyHpcUsage = Bool
+
+emptyHpcInfo :: AnyHpcUsage -> HpcInfo
+emptyHpcInfo = NoHpcInfo
+
+-- | Find out if HPC is used by this module or any of the modules
+-- it depends upon
+isHpcUsed :: HpcInfo -> AnyHpcUsage
+isHpcUsed (HpcInfo {}) = True
+isHpcUsed (NoHpcInfo { hpcUsed = used }) = used
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Vectorisation Support}
+%* *
+%************************************************************************
+
+The following information is generated and consumed by the vectorisation
+subsystem. It communicates the vectorisation status of declarations from one
+module to another.
+
+Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
+below? We need to know `f' when converting to IfaceVectInfo. However, during
+vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
+on just the OccName easily in a Core pass.
+
+\begin{code}
+-- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'.
+-- All of this information is always tidy, even in ModGuts.
+data VectInfo
+ = VectInfo {
+ vectInfoVar :: VarEnv (Var , Var ), -- ^ @(f, f_v)@ keyed on @f@
+ vectInfoTyCon :: NameEnv (TyCon , TyCon), -- ^ @(T, T_v)@ keyed on @T@
+ vectInfoDataCon :: NameEnv (DataCon, DataCon), -- ^ @(C, C_v)@ keyed on @C@
+ vectInfoPADFun :: NameEnv (TyCon , Var), -- ^ @(T_v, paT)@ keyed on @T_v@
+ vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@
+ }
+
+-- | Vectorisation information for 'ModIface': a slightly less low-level view
+data IfaceVectInfo
+ = IfaceVectInfo {
+ ifaceVectInfoVar :: [Name],
+ -- ^ All variables in here have a vectorised variant
+ ifaceVectInfoTyCon :: [Name],
+ -- ^ All 'TyCon's in here have a vectorised variant;
+ -- the name of the vectorised variant and those of its
+ -- data constructors are determined by 'OccName.mkVectTyConOcc'
+ -- and 'OccName.mkVectDataConOcc'; the names of
+ -- the isomorphisms are determined by 'OccName.mkVectIsoOcc'
+ ifaceVectInfoTyConReuse :: [Name]
+ -- ^ The vectorised form of all the 'TyCon's in here coincides with
+ -- the unconverted form; the name of the isomorphisms is determined
+ -- by 'OccName.mkVectIsoOcc'
+ }
+
+noVectInfo :: VectInfo
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
-noHpcInfo :: HpcInfo
-noHpcInfo = 0 -- default = 0
+plusVectInfo :: VectInfo -> VectInfo -> VectInfo
+plusVectInfo vi1 vi2 =
+ VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
+ (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
+ (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+ (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
+ (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+
+concatVectInfo :: [VectInfo] -> VectInfo
+concatVectInfo = foldr plusVectInfo noVectInfo
+
+noIfaceVectInfo :: IfaceVectInfo
+noIfaceVectInfo = IfaceVectInfo [] [] []
\end{code}
%************************************************************************
stuff is the *dynamic* linker, and isn't present in a stage-1 compiler
\begin{code}
+-- | Information we can use to dynamically link modules into the compiler
data Linkable = LM {
- linkableTime :: ClockTime, -- Time at which this linkable was built
+ linkableTime :: ClockTime, -- ^ Time at which this linkable was built
-- (i.e. when the bytecodes were produced,
-- or the mod date on the files)
- linkableModule :: Module, -- Should be Module, but see below
- linkableUnlinked :: [Unlinked]
+ linkableModule :: Module, -- ^ The linkable module itself
+ linkableUnlinked :: [Unlinked] -- ^ Those files and chunks of code we have
+ -- yet to link
}
isObjectLinkable :: Linkable -> Bool
$$ nest 3 (ppr unlinkeds)
-------------------------------------------
+
+-- | Objects which have yet to be linked by the compiler
data Unlinked
- = DotO FilePath
- | DotA FilePath
- | DotDLL FilePath
- | BCOs CompiledByteCode
+ = DotO FilePath -- ^ An object file (.o)
+ | DotA FilePath -- ^ Static archive file (.a)
+ | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib)
+ | BCOs CompiledByteCode ModBreaks -- ^ A byte-code object, lives only in memory
#ifndef GHCI
-data CompiledByteCode = NoByteCode
+data CompiledByteCode = CompiledByteCodeUndefined
+_unused :: CompiledByteCode
+_unused = CompiledByteCodeUndefined
#endif
instance Outputable Unlinked where
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
#ifdef GHCI
- ppr (BCOs bcos) = text "BCOs" <+> ppr bcos
+ ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
#else
- ppr (BCOs bcos) = text "No byte code"
+ ppr (BCOs _ _) = text "No byte code"
#endif
+-- | Is this an actual file on disk we can link in somehow?
+isObject :: Unlinked -> Bool
isObject (DotO _) = True
isObject (DotA _) = True
isObject (DotDLL _) = True
isObject _ = False
+-- | Is this a bytecode linkable with no file on disk?
+isInterpretable :: Unlinked -> Bool
isInterpretable = not . isObject
+-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object
+nameOfObject :: Unlinked -> FilePath
nameOfObject (DotO fn) = fn
nameOfObject (DotA fn) = fn
nameOfObject (DotDLL fn) = fn
nameOfObject other = pprPanic "nameOfObject" (ppr other)
-byteCodeOfObject (BCOs bc) = bc
-byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
+-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
+byteCodeOfObject :: Unlinked -> CompiledByteCode
+byteCodeOfObject (BCOs bc _) = bc
+byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
\end{code}
+%************************************************************************
+%* *
+\subsection{Breakpoint Support}
+%* *
+%************************************************************************
+\begin{code}
+-- | Breakpoint index
+type BreakIndex = Int
+
+-- | All the information about the breakpoints for a given module
+data ModBreaks
+ = ModBreaks
+ { modBreaks_flags :: BreakArray
+ -- ^ The array of flags, one per breakpoint,
+ -- indicating which breakpoints are enabled.
+ , modBreaks_locs :: !(Array BreakIndex SrcSpan)
+ -- ^ An array giving the source span of each breakpoint.
+ , modBreaks_vars :: !(Array BreakIndex [OccName])
+ -- ^ An array giving the names of the free variables at each breakpoint.
+ }
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaks
+ { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
+ -- Todo: can we avoid this?
+ , modBreaks_locs = array (0,-1) []
+ , modBreaks_vars = array (0,-1) []
+ }
+\end{code}
projects / ghc-hetmet.git / blobdiff