\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,
- throwOneError, handleSourceError,
- reflectGhc, reifyGhc,
- handleFlagWarnings,
-
- -- * Sessions and compilation state
- Session(..), withSession, modifySession, withTempSession,
+ -- * compilation state
HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
- -- ** Callbacks
- GhcApiCallbacks(..), withLocalCallbacks,
-- * Information about modules
ModDetails(..), emptyModDetails,
- ModGuts(..), CoreModule(..), CgGuts(..), ForeignStubs(..),
+ ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
-- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules, hptVectInfo,
-
+ hptInstances, hptRules, hptVectInfo,
+ hptObjs,
+
-- * State relating to known packages
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-- * Interactive context
InteractiveContext(..), emptyInteractiveContext,
- icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
+ icPrintUnqual, extendInteractiveContext,
substInteractiveContext,
+ mkPrintUnqualified, pprModulePrefix,
-- * Interfaces
ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
-- * TyThings and type environments
TyThing(..),
- tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
- implicitTyThings, isImplicitTyThing,
+ tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId, tyThingCoAxiom,
+ implicitTyThings, implicitTyConThings, implicitClassThings, isImplicitTyThing,
TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
- typeEnvDataCons,
+ typeEnvDataCons, typeEnvCoAxioms,
-- * MonadThings
MonadThings(..),
Warnings(..), WarningTxt(..), plusWarns,
-- * Linker stuff
- Linkable(..), isObjectLinkable,
+ Linkable(..), isObjectLinkable, linkableObjs,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-- * Vectorisation information
VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
- noIfaceVectInfo
+ noIfaceVectInfo,
+
+ -- * Compilation errors and warnings
+ SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
+ throwOneError, handleSourceError,
+ handleFlagWarnings, printOrThrowWarnings,
) where
#include "HsVersions.h"
#ifdef GHCI
-import ByteCodeAsm ( CompiledByteCode )
+import ByteCodeAsm ( CompiledByteCode )
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
+import HsSyn
import RdrName
import Name
import NameEnv
-import NameSet
-import OccName ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv,
- extendOccEnv )
+import NameSet
import Module
-import InstEnv ( InstEnv, Instance )
-import FamInstEnv ( FamInstEnv, FamInst )
-import Rules ( RuleBase )
-import CoreSyn ( CoreBind )
+import InstEnv ( InstEnv, Instance )
+import FamInstEnv ( FamInstEnv, FamInst )
+import Rules ( RuleBase )
+import CoreSyn ( CoreBind )
import VarEnv
import VarSet
import Var
import Id
-import Type
+import Type
import Annotations
-import Class ( Class, classSelIds, classATs, classTyCon )
+import Class ( Class, classAllSelIds, classATs, classTyCon )
import TyCon
import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..), dopt,
DynFlag(..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) )
+import BasicTypes ( IPName, defaultFixity, WarningTxt(..) )
import OptimizationFuel ( OptFuelState )
import IfaceSyn
-import FiniteMap ( FiniteMap )
-import CoreSyn ( CoreRule )
+import CoreSyn ( CoreRule, CoreVect )
import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
-import SrcLoc ( SrcSpan, Located(..) )
-import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
+import SrcLoc
+import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
import StringBuffer ( StringBuffer )
import Data.IORef
import Data.Array ( Array, array )
import Data.List
+import Data.Map (Map)
import Control.Monad ( mplus, guard, liftM, when )
import Exception
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Compilation environment}
-%* *
-%************************************************************************
+-- -----------------------------------------------------------------------------
+-- Source Errors
-\begin{code}
--- | The Session is a handle to the complete state of a compilation
--- session. A compilation session consists of a set of modules
--- constituting the current program or library, the context for
--- interactive evaluation, and various caches.
-data Session = Session !(IORef HscEnv) !(IORef WarningMessages)
+-- When the compiler (HscMain) discovers errors, it throws an
+-- exception in the IO monad.
mkSrcErr :: ErrorMessages -> SourceError
srcErrorMessages :: SourceError -> ErrorMessages
mkApiErr = GhcApiError
--- | 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
-
-withSavedSession :: GhcMonad m => m a -> m a
-withSavedSession m = do
- saved_session <- getSession
- m `gfinally` setSession saved_session
-
--- | Call an action with a temporarily modified Session.
-withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
-withTempSession f m =
- withSavedSession $ modifySession f >> m
-
--- | 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
- gblock (Ghc m) = Ghc $ \s -> gblock (m s)
- gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
-
-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
- gblock (GhcT m) = GhcT $ \s -> gblock (m s)
- gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
-
-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 -> liftIO $ throwIO (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
+-- | Given a bag of warnings, turn them into an exception if
+-- -Werror is enabled, or print them out otherwise.
+printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
+printOrThrowWarnings dflags warns
+ | dopt Opt_WarnIsError dflags
+ = when (not (isEmptyBag warns)) $ do
+ throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg
+ | otherwise
+ = printBagOfWarnings dflags warns
-handleFlagWarnings :: GhcMonad m => DynFlags -> [Located String] -> m ()
+handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
handleFlagWarnings dflags warns
- = when (dopt Opt_WarnDeprecatedFlags dflags)
- (handleFlagWarnings' dflags warns)
-
-handleFlagWarnings' :: GhcMonad m => DynFlags -> [Located String] -> m ()
-handleFlagWarnings' _ [] = return ()
-handleFlagWarnings' dflags warns
- = do -- It would be nicer if warns :: [Located Message], but that has circular
- -- import problems.
- logWarnings $ listToBag (map mkFlagWarning warns)
- when (dopt Opt_WarnIsError dflags) $
- liftIO $ throwIO $ mkSrcErr emptyBag
-
-mkFlagWarning :: Located String -> WarnMsg
-mkFlagWarning (L loc warn)
- = mkPlainWarnMsg loc (text warn)
-\end{code}
-
-\begin{code}
--- | These functions are called in various places of the GHC API.
---
--- API clients can override any of these callbacks to change GHC's default
--- behaviour.
-data GhcApiCallbacks
- = GhcApiCallbacks {
-
- -- | Called by 'load' after the compilating of each module.
- --
- -- The default implementation simply prints all warnings and errors to
- -- @stderr@. Don't forget to call 'clearWarnings' when implementing your
- -- own call.
- --
- -- The first argument is the module that was compiled.
- --
- -- The second argument is @Nothing@ if no errors occured, but there may
- -- have been warnings. If it is @Just err@ at least one error has
- -- occured. If 'srcErrorMessages' is empty, compilation failed due to
- -- @-Werror@.
- reportModuleCompilationResult :: GhcMonad m =>
- ModSummary -> Maybe SourceError
- -> m ()
- }
-
--- | Temporarily modify the callbacks. After the action is executed all
--- callbacks are reset (not, however, any other modifications to the session
--- state.)
-withLocalCallbacks :: GhcMonad m =>
- (GhcApiCallbacks -> GhcApiCallbacks)
- -> m a -> m a
-withLocalCallbacks f m = do
- hsc_env <- getSession
- let cb0 = hsc_callbacks hsc_env
- let cb' = f cb0
- setSession (hsc_env { hsc_callbacks = cb' `seq` cb' })
- r <- m
- hsc_env' <- getSession
- setSession (hsc_env' { hsc_callbacks = cb0 })
- return r
+ = when (dopt Opt_WarnDeprecatedFlags dflags) $ do
+ -- It would be nicer if warns :: [Located Message], but that
+ -- has circular import problems.
+ let bag = listToBag [ mkPlainWarnMsg loc (text warn)
+ | L loc warn <- warns ]
+ printOrThrowWarnings dflags bag
\end{code}
\begin{code}
hsc_dflags :: DynFlags,
-- ^ The dynamic flag settings
- hsc_callbacks :: GhcApiCallbacks,
- -- ^ Callbacks for the GHC API.
-
hsc_targets :: [Target],
-- ^ The targets (or roots) of the current session
-- by limiting the number of transformations,
-- we can use binary search to help find compiler bugs.
- hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
+ 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
-- And get its dfuns
, thing <- things ]
+
+hptObjs :: HomePackageTable -> [FilePath]
+hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
\end{code}
%************************************************************************
-- ^ The requested package was not found
| FoundMultiple [PackageId]
-- ^ _Error_: both in multiple packages
- | PackageHidden PackageId
- -- ^ 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
- -- exposed, but the module itself is hidden.
- | NotFound [FilePath] (Maybe PackageId)
- -- ^ The module was not found, the specified places were searched
- | NotFoundInPackage PackageId
- -- ^ The module was not found in this package
+
+ | NotFound -- Not found
+ { fr_paths :: [FilePath] -- Places where I looked
+
+ , fr_pkg :: Maybe PackageId -- Just p => module is in this package's
+ -- manifest, but couldn't find
+ -- the .hi file
+
+ , fr_mods_hidden :: [PackageId] -- Module is in these packages,
+ -- but the *module* is hidden
+
+ , fr_pkgs_hidden :: [PackageId] -- Module is in these packages,
+ -- but the *package* is hidden
+
+ , fr_suggestions :: [Module] -- Possible mis-spelled modules
+ }
-- | Cache that remembers where we found a particular module. Contains both
-- home modules and package modules. On @:load@, only home modules are
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)
+ -- ^ The dependencies of the module. This is
+ -- consulted for directly-imported modules, but not
+ -- for anything else (hence lazy)
+
mi_usages :: [Usage],
-- ^ Usages; kept sorted so that it's easy to decide
-- whether to write a new iface file (changing usages
-- | 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.
+-- 'ModDetails' are extracted and the ModGuts is discarded.
data ModGuts
= ModGuts {
mg_module :: !Module, -- ^ Module being compiled
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
+ -- See Note [Overall plumbing for rules] in Rules.lhs
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_anns :: [Annotation], -- ^ Annotations declared in this module
- mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
+ mg_anns :: [Annotation], -- ^ Annotations declared in this module
+ mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
mg_modBreaks :: !ModBreaks, -- ^ Breakpoints for the module
+ mg_vect_decls:: ![CoreVect], -- ^ Vectorisation declarations in this module
+ -- (produced by desugarer & consumed by vectoriser)
mg_vect_info :: !VectInfo, -- ^ Pool of vectorised declarations in the module
-- The next two fields are unusual, because they give instance
-- 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:
-- 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
- -- initialisation code
-
- cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
+ 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
--
-- 2) C stubs to use when calling
-- "foreign exported" functions
+
+appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
+appendStubC NoStubs c_code = ForeignStubs empty c_code
+appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
\end{code}
\begin{code}
%************************************************************************
\begin{code}
--- | Interactive context, recording information relevant to GHCi
+-- | Interactive context, recording information about the state of the
+-- context in which statements are executed in a GHC session.
+--
data InteractiveContext
= InteractiveContext {
- ic_toplev_scope :: [Module], -- ^ The context includes the "top-level" scope of
- -- these modules
-
- ic_exports :: [Module], -- ^ The context includes just the exports of these
- -- modules
-
- 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_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.
+ -- These two fields are only stored here so that the client
+ -- can retrieve them with GHC.getContext. GHC itself doesn't
+ -- use them, but it does reset them to empty sometimes (such
+ -- as before a GHC.load). The context is set with GHC.setContext.
+ ic_toplev_scope :: [Module],
+ -- ^ The context includes the "top-level" scope of
+ -- these modules
+ ic_imports :: [ImportDecl RdrName],
+ -- ^ The context is extended with these import declarations
+
+ ic_rn_gbl_env :: GlobalRdrEnv,
+ -- ^ The contexts' cached 'GlobalRdrEnv', built by
+ -- 'InteractiveEval.setContext'
+
+ ic_tmp_ids :: [Id],
+ -- ^ Names bound during interaction with the user. Later
+ -- Ids shadow earlier ones with the same OccName
+ -- Expressions are typed with these Ids in the envt For
+ -- runtime-debugging, these Ids may have free TcTyVars of
+ -- RuntimUnkSkol flavour, but no free TyVars (because the
+ -- typechecker doesn't expect that)
#ifdef GHCI
- , ic_resume :: [Resume] -- ^ The stack of breakpoint contexts
+ ic_resume :: [Resume],
+ -- ^ The stack of breakpoint contexts
#endif
+
+ ic_cwd :: Maybe FilePath
+ -- virtual CWD of the program
}
emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
- ic_exports = [],
+ ic_imports = [],
ic_rn_gbl_env = emptyGlobalRdrEnv,
- ic_tmp_ids = [],
- ic_tyvars = emptyVarSet
+ ic_tmp_ids = []
#ifdef GHCI
, ic_resume = []
#endif
+ , ic_cwd = Nothing
}
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
extendInteractiveContext
:: InteractiveContext
-> [Id]
- -> TyVarSet
-> InteractiveContext
-extendInteractiveContext ictxt ids tyvars
- = ictxt { ic_tmp_ids = snub((ic_tmp_ids ictxt \\ ids) ++ ids),
+extendInteractiveContext ictxt ids
+ = 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
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst
+ = ictxt { ic_tmp_ids = map subst_ty ids }
+ where
+ subst_ty id = id `setIdType` substTy subst (idType id)
\end{code}
%************************************************************************
%* *
%************************************************************************
+Note [Printing original names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
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.
+ 1. T uniquely maps to P:M.T ---> "T" NameUnqual
+ 2. There is an X for which X.T
+ uniquely maps to P:M.T ---> "X.T" NameQual X
+ 3. There is no binding for "M.T" ---> "M.T" NameNotInScope1
+ 4. Otherwise ---> "P:M.T" NameNotInScope2
+
+(3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
+all. In these cases we still 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. Instead we write P:M.T.
+
+There's one further subtlety: in case (3), what if there are two
+things around, P1:M.T and P2:M.T? Then we don't want to print both of
+them as M.T! However only one of the modules P1:M and P2:M can be
+exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
+This is handled by the qual_mod component of PrintUnqualified, inside
+the (ppr mod) of case (3), in Name.pprModulePrefix
\begin{code}
-- | Creates some functions that work out the best ways to format
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter.
implicitTyThings :: TyThing -> [TyThing]
-
--- 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)
-
-implicitTyThings (AClass cl)
- = -- dictionary datatype:
+implicitTyThings (AnId _) = []
+implicitTyThings (ACoAxiom _cc) = []
+implicitTyThings (ATyCon tc) = implicitTyConThings tc
+implicitTyThings (AClass cl) = implicitClassThings cl
+implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
+ -- For data cons add the worker and (possibly) wrapper
+
+implicitClassThings :: Class -> [TyThing]
+implicitClassThings cl
+ = -- Does not include default methods, because those Ids may have
+ -- their own pragmas, unfoldings etc, not derived from the Class object
+ -- Dictionary datatype:
-- [extras_plus:]
-- type constructor
-- [recursive call:]
-- are only the family decls; they have no implicit things
map ATyCon (classATs cl) ++
-- superclass and operation selectors
- map AnId (classSelIds cl)
+ map AnId (classAllSelIds cl)
-implicitTyThings (ADataCon dc) =
- -- For data cons add the worker and (possibly) wrapper
- map AnId (dataConImplicitIds dc)
+implicitTyConThings :: TyCon -> [TyThing]
+implicitTyConThings tc
+ = -- fields (names of selectors)
+ -- (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)
-implicitTyThings (AnId _) = []
-- add a thing and recursive call
extras_plus :: TyThing -> [TyThing]
-- add the implicit coercion tycon
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon tc
- = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
- newTyConCo_maybe tc,
+ = map ACoAxiom . catMaybes $ [-- Just if newtype, Nothing if not
+ newTyConCo_maybe tc,
-- Just if family instance, Nothing if not
- tyConFamilyCoercion_maybe tc]
+ tyConFamilyCoercion_maybe tc]
-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)
-- of some other declaration, or it is generated implicitly by some
-- other declaration.
isImplicitTyThing :: TyThing -> Bool
-isImplicitTyThing (ADataCon _) = True
-isImplicitTyThing (AnId id) = isImplicitId id
-isImplicitTyThing (AClass _) = False
-isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
+isImplicitTyThing (ADataCon {}) = True
+isImplicitTyThing (AnId id) = isImplicitId id
+isImplicitTyThing (AClass {}) = False
+isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
+isImplicitTyThing (ACoAxiom {}) = True
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvClasses :: TypeEnv -> [Class]
typeEnvTyCons :: TypeEnv -> [TyCon]
+typeEnvCoAxioms :: TypeEnv -> [CoAxiom]
typeEnvIds :: TypeEnv -> [Id]
typeEnvDataCons :: TypeEnv -> [DataCon]
lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
typeEnvElts env = nameEnvElts env
typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
+typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
typeEnvIds env = [id | AnId id <- typeEnvElts env]
typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env]
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
+-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
+tyThingCoAxiom :: TyThing -> CoAxiom
+tyThingCoAxiom (ACoAxiom ax) = ax
+tyThingCoAxiom other = pprPanic "tyThingCoAxiom" (pprTyThing other)
+
-- | Get the 'Class' from a 'TyThing' if it is a class thing. Panics otherwise
tyThingClass :: TyThing -> Class
tyThingClass (AClass cls) = cls
type OrigNameCache = ModuleEnv (OccEnv Name)
-- | Module-local cache of implicit parameter 'OccName's given 'Name's
-type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
+type OrigIParamCache = Map (IPName OccName) (IPName Name)
\end{code}
-- 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.
+-- The graph is not necessarily stored in topologically-sorted order. Use
+-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.
type ModuleGraph = [ModSummary]
emptyMG :: ModuleGraph
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_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module
+ ms_imps :: [Located (ImportDecl RdrName)], -- ^ 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
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Vectorisation Support}
-%* *
+%* *
%************************************************************************
The following information is generated and consumed by the vectorisation
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.
+-- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
+-- documentation at 'Vectorise.Env.GlobalEnv'.
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@
+ = 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@
+ , vectInfoScalarVars :: VarSet -- ^ set of purely scalar variables
+ , vectInfoScalarTyCons :: NameSet -- ^ set of scalar type constructors
}
--- | Vectorisation information for 'ModIface': a slightly less low-level view
+-- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
+-- across module boundaries.
+--
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'
+ = 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'
+ , ifaceVectInfoScalarVars :: [Name] -- iface version of 'vectInfoScalarVar'
+ , ifaceVectInfoScalarTyCons :: [Name] -- iface version of 'vectInfoScalarTyCon'
}
noVectInfo :: VectInfo
-noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
+noVectInfo
+ = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyVarSet
+ emptyNameSet
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)
+ 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)
+ (vectInfoScalarVars vi1 `unionVarSet` vectInfoScalarVars vi2)
+ (vectInfoScalarTyCons vi1 `unionNameSets` vectInfoScalarTyCons vi2)
concatVectInfo :: [VectInfo] -> VectInfo
concatVectInfo = foldr plusVectInfo noVectInfo
noIfaceVectInfo :: IfaceVectInfo
-noIfaceVectInfo = IfaceVectInfo [] [] []
+noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
\end{code}
%************************************************************************
-- compiling a module in HscNothing mode, and this choice
-- happens to work well with checkStability in module GHC.
+linkableObjs :: Linkable -> [FilePath]
+linkableObjs l = [ f | DotO f <- linkableUnlinked l ]
+
instance Outputable Linkable where
ppr (LM when_made mod unlinkeds)
= (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
-- ^ 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.
+ , modBreaks_decls :: !(Array BreakIndex [String])
+ -- ^ An array giving the names of the declarations enclosing 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) []
+ , modBreaks_locs = array (0,-1) []
+ , modBreaks_vars = array (0,-1) []
+ , modBreaks_decls = array (0,-1) []
}
\end{code}
projects / ghc-hetmet.git / blobdiff