\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,
-- * 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 RdrName
import Name
import NameEnv
-import NameSet
+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 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}
+-- -----------------------------------------------------------------------------
+-- Source Errors
-%************************************************************************
-%* *
-\subsection{Compilation environment}
-%* *
-%************************************************************************
-
-
-\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
- | NotFound [FilePath] (Maybe PackageId) [PackageId] [PackageId]
- -- ^ The module was not found, including either
- -- * the specified places were searched
- -- * the package that this module should have been in
- -- * list of packages in which the module was hidden,
- -- * list of hidden packages containing this module
- | 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
-- | 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
+ 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
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}
%************************************************************************
-- 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)
- -- (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}
\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'.
+-- |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